gavin/devops
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

first commit

Browse Source
This commit is contained in:
douboer
2025-09-17 16:08:16 +08:00
parent 9395faa6b2
commit 3ff47c11d5
1318 changed files with 117477 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
perl/lib/Graph-Easy-0.76.tar.gz Normal file
View File

Binary file not shown.

58
perl/lib/Graph-Easy-0.76/Build.PL Normal file
View File

@@ -0,0 +1,58 @@
# We need at least Perl 5.8.2 for proper Unicode support
use 5.008002;
use strict;
use warnings;
use File::Spec;
use lib File::Spec->catdir(File::Spec->curdir(), "inc");
# recommends 'Graph::Easy::As_svg' => 0.23;
use Test::Run::Builder;
my $build = Test::Run::Builder->new(
'module_name' => "Graph::Easy",
configure_requires =>
{
'Module::Build' => '0.36',
},
build_requires =>
{
'Test::More' => '0.62',
},
'requires' =>
{
'Scalar::Util' => '1.13',
'perl' => '5.8.2',
'strict' => 0,
'warnings' => 0,
'vars' => 0,
},
'recommends' =>
{
'Graph::Easy::As_svg' => 0.23
},
'license' => "gpl",
meta_merge =>
{
resources =>
{
repository => "https://bitbucket.org/shlomif/perl-graph-easy",
},
keywords =>
[
'generation',
'graph',
'graphviz',
'text generation',
'text',
],
},
create_makefile_pl => 'traditional',
'scripts' =>
[
'bin/graph-easy',
],
);
$build->create_build_script;

2007
perl/lib/Graph-Easy-0.76/CHANGES Normal file
View File

File diff suppressed because it is too large Load Diff

73
perl/lib/Graph-Easy-0.76/INSTALL Normal file
View File

@@ -0,0 +1,73 @@
=pod
=head1 Graph-Easy
I<Note:> This package was formerly known as Graph::Simple.
=head1 INSTALLATION
=head2 Linux, Unix, and similar systems:
To install this module type the following:
Untar the package:
tar -xzf Graph-Easy-x.xx.tar.gz
where x.xx is the current revision. Then change into the directory:
chdir Graph-Easy-x.xx/
Proceed with creating the makefile and running the test suite:
perl Makefile.PL
make test
If all tests pass, install the package as root user:
sudo make install
=head2 Windows
You need two things under Windows:
=over 2
=item Perl
You can get it from ActiveState:
http://activestate.com/store/activeperl/download
=item nmake
See here for how to get and install nmake:
http://johnbokma.com/perl/make-for-windows.html
=back
After installing C<Perl> and C<nmake>, you can install Graph::Easy normally, just replacing
C<make> with C<nmake> in the install instructions above:
perl Makefile.PL
nmake
nmake test
nmake install
=head1 SEE ALSO
You also might want to install the following packages from CPAN:
Graph::Easy::As_svg provide SVG (Scalable Vector Graphics) output
Graph::Easy::Manual comprehensive manual in POD and HTML
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com/perl/>
This library is free software; you can redistribute it and/or modify
it under the same terms of the GPL version 2.
=cut

335
perl/lib/Graph-Easy-0.76/LICENSE Normal file
View File

@@ -0,0 +1,335 @@
=pod
=head1 LICENSES
=head2 Colorschemes
This product includes color specifications and designs developed by Cynthia
Brewer (http://colorbrewer.org/). The following license applies to them:
Apache-Style Software License for ColorBrewer Color Schemes v1.1
Copyright (c) 2002 Cynthia Brewer, Mark Harrower, and The Pennsylvania State
University. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions as source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. The end-user documentation included with the redistribution, if any,
must include the following acknowledgment:
This product includes color specifications and designs developed by Cynthia
Brewer (http://colorbrewer.org/).
Alternately, this acknowledgment may appear in the software itself, if and
wherever such third-party acknowledgments normally appear.
3. The name "ColorBrewer" must not be used to endorse or promote products
derived from this software without prior written permission. For written
permission, please contact Cynthia Brewer at cbrewer at psu dot edu.
4. Products derived from this software may not be called "ColorBrewer", nor
may "ColorBrewer" appear in their name, without prior written permission
of Cynthia Brewer.
THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL CYNTHIA
BREWER, MARK HARROWER, OR THE PENNSYLVANIA STATE UNIVERSITY BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=head2 All other things included in this package
To the rest of the code, documentation, scripts etc. the following
license applies:
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
=cut

769
perl/lib/Graph-Easy-0.76/MANIFEST Normal file
View File

@@ -0,0 +1,769 @@
bench/bench.pl
bench/serie.pl
bench/stress.pl
bench/test.dot
bench/test.txt
bin/graph-easy
Build.PL
CHANGES
examples/as_ascii
examples/as_boxart
examples/as_boxart_html
examples/as_graphviz
examples/as_html
examples/as_svg
examples/as_txt
examples/ascii.pl
examples/base.css
examples/common.pl
examples/complex.txt
examples/fun.tpl
examples/history.txt
examples/html.pl
examples/parse
examples/syntax.pl
examples/syntax.tpl
examples/wikicrawl.pl
inc/Test/Run/Builder.pm
INSTALL
lib/Graph/Easy.pm
lib/Graph/Easy/As_ascii.pm
lib/Graph/Easy/As_graphml.pm
lib/Graph/Easy/As_graphviz.pm
lib/Graph/Easy/As_txt.pm
lib/Graph/Easy/As_vcg.pm
lib/Graph/Easy/Attributes.pm
lib/Graph/Easy/Base.pm
lib/Graph/Easy/Edge.pm
lib/Graph/Easy/Edge/Cell.pm
lib/Graph/Easy/Group.pm
lib/Graph/Easy/Group/Anon.pm
lib/Graph/Easy/Group/Cell.pm
lib/Graph/Easy/Layout.pm
lib/Graph/Easy/Layout/Chain.pm
lib/Graph/Easy/Layout/Force.pm
lib/Graph/Easy/Layout/Grid.pm
lib/Graph/Easy/Layout/Path.pm
lib/Graph/Easy/Layout/Repair.pm
lib/Graph/Easy/Layout/Scout.pm
lib/Graph/Easy/Node.pm
lib/Graph/Easy/Node/Anon.pm
lib/Graph/Easy/Node/Cell.pm
lib/Graph/Easy/Node/Empty.pm
lib/Graph/Easy/Parser.pm
lib/Graph/Easy/Parser/Graphviz.pm
lib/Graph/Easy/Parser/VCG.pm
lib/Graph/Easy/Util.pm
LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
META.json
META.yml
README
scripts/bump-version-number.pl
t/anon.t
t/anon_group.t
t/as_txt.t
t/as_vcg.t
t/ascii.t
t/astar.t
t/attributes.t
t/base.t
t/boxart.t
t/cell.t
t/chain.t
t/class.t
t/cluster.t
t/copy.t
t/custom.t
t/delete.t
t/dot/4_loose.dot
t/drop.t
t/easypm.t
t/edge.t
t/edge_cell.t
t/fb.t
t/fun/0000.txt
t/fun/0010.txt
t/fun/0011.txt
t/fun/0020.txt
t/fun/0030.txt
t/fun/0131.txt
t/fun/0200.txt
t/fun/biofuel.txt
t/fun/geek_dating.txt
t/fun/overview.txt
t/gdl.t
t/graph-maker.t
t/graph.t
t/graphml.t
t/graphml_yed.t
t/graphviz.t
t/group.t
t/group/0010.txt
t/group/0131.txt
t/group/0230.txt
t/gv.t
t/heap.t
t/html.t
t/in/0_empty_group.txt
t/in/0_empty_groups.txt
t/in/10_repair.txt
t/in/10borders.txt
t/in/18_multiples.txt
t/in/1_bidi_loop.txt
t/in/1_empty_group.txt
t/in/1_selfloop.txt
t/in/1_selfloop_2.txt
t/in/1_selfloop_label.txt
t/in/1_undirected_loop.txt
t/in/1node.txt
t/in/25_autosplit_empty.txt
t/in/2_autolabel.txt
t/in/2_autosplit_empty.txt
t/in/2_autosplit_escaped.txt
t/in/2_bidi_astar.txt
t/in/2_bidi_endpoint.txt
t/in/2_class.txt
t/in/2_classes.txt
t/in/2_cluster.txt
t/in/2_cluster_2.txt
t/in/2_cluster_3.txt
t/in/2_dot.txt
t/in/2_dot_dot_dash.txt
t/in/2_edges.txt
t/in/2_flow.txt
t/in/2_graph_label.txt
t/in/2_group.txt
t/in/2_group_labelpos.txt
t/in/2_group_multicell.txt
t/in/2_group_no_border.txt
t/in/2_invisible_left.txt
t/in/2_invisible_right.txt
t/in/2_label.txt
t/in/2_label_align.txt
t/in/2_list_attr.txt
t/in/2_long_labels.txt
t/in/2_newlines.txt
t/in/2_selfloop.txt
t/in/2_selfloop_flow_down.txt
t/in/2_split_bug.txt
t/in/2_wrap.txt
t/in/2_zeros.txt
t/in/2nodes.txt
t/in/3_autosplit_hang.txt
t/in/3_bend_bug.txt
t/in/3_cache_bug.txt
t/in/3_cluster.txt
t/in/3_colors.txt
t/in/3_corrupt.txt
t/in/3_edge_labels_from_class.txt
t/in/3_edge_repair.txt
t/in/3_edge_start.txt
t/in/3_empty_group.txt
t/in/3_flow.txt
t/in/3_group_align_center.txt
t/in/3_inherit.txt
t/in/3_invisible_both.txt
t/in/3_joining.txt
t/in/3_joint.txt
t/in/3_joint_short.txt
t/in/3_list_attr.txt
t/in/3_lists.txt
t/in/3_nodes_5_edges.txt
t/in/3_selfloop.txt
t/in/3_selfloop_flip.txt
t/in/3_selfloop_flow_down.txt
t/in/3_selfloop_flow_left.txt
t/in/3_selfloop_flow_up.txt
t/in/3_split_attribute.txt
t/in/3nodes.txt
t/in/4_2x2nodes.txt
t/in/4_att.txt
t/in/4_autosplit_class.txt
t/in/4_autosplit_empty.txt
t/in/4_autosplit_offset.txt
t/in/4_autosplit_shape.txt
t/in/4_bend_bug.txt
t/in/4_bug_basename.txt
t/in/4_bug_joint_2.txt
t/in/4_collapse.txt
t/in/4_comma.txt
t/in/4_cross.txt
t/in/4_cross_inv.txt
t/in/4_cross_split.txt
t/in/4_cross_split_hor.txt
t/in/4_edge_cross.txt
t/in/4_edge_labels.txt
t/in/4_edge_types.txt
t/in/4_endless_loop.txt
t/in/4_endless_loop_2.txt
t/in/4_flow.txt
t/in/4_flow_chain.txt
t/in/4_invisible.txt
t/in/4_joint.txt
t/in/4_joint_bug_flags.txt
t/in/4_list_attr.txt
t/in/4_lists.txt
t/in/4_minlen.txt
t/in/4_near.txt
t/in/4_node_edge.txt
t/in/4_nodes_5_edges.txt
t/in/4_nodes_6_edges.txt
t/in/4_nodes_edge.txt
t/in/4groups.txt
t/in/4groups_class.txt
t/in/4nodes.txt
t/in/5_a-star_bug.txt
t/in/5_arrow_styles.txt
t/in/5_flow.txt
t/in/5_group_repair.txt
t/in/5_group_split.txt
t/in/5_joint.txt
t/in/5_joint_bug2.txt
t/in/5_joint_label.txt
t/in/5_long_edge_labels.txt
t/in/5_multicell.txt
t/in/5_offsets.txt
t/in/5_offsets_2.txt
t/in/5_rounded.txt
t/in/5_tree_joint.txt
t/in/6_autosplit_class.txt
t/in/6_chain_10_edges.txt
t/in/6_chained.txt
t/in/6_empty_row.txt
t/in/6_fanout.txt
t/in/6_group_align.txt
t/in/6_joint.txt
t/in/6_multicell.txt
t/in/6_multicell_offset.txt
t/in/6_nested_groups.txt
t/in/6_ranks.txt
t/in/6_split_join_loop.txt
t/in/7_cluster.txt
t/in/7_star.txt
t/in/7_tree.txt
t/in/8_align.txt
t/in/8_basename.txt
t/in/8_chain.txt
t/in/8_endless_loop.txt
t/in/8_flow.txt
t/in/8_invisible.txt
t/in/8_labels.txt
t/in/8_optimize_bend.txt
t/in/8_points.txt
t/in/9_chain.txt
t/in/9_cross.txt
t/in/9_flow_south.txt
t/in/dot/0_empty.dot
t/in/dot/10_numbers.dot
t/in/dot/16_split.dot
t/in/dot/2_bool.dot
t/in/dot/2_comment_inside_attr.dot
t/in/dot/2_graph_label_bottom.dot
t/in/dot/2_group_labelloc.dot
t/in/dot/2_ignore.dot
t/in/dot/2_linewidth.dot
t/in/dot/2_no_spaces.dot
t/in/dot/2_nospace.dot
t/in/dot/2_ports.dot
t/in/dot/2_setlinewidth.dot
t/in/dot/2_square_bracket_in_attr.dot
t/in/dot/2_strict.dot
t/in/dot/3_colors.dot
t/in/dot/3_empty_record.dot
t/in/dot/3_empty_record_LR.dot
t/in/dot/3_graph_label_long.dot
t/in/dot/3_ids.dot
t/in/dot/3_invis.dot
t/in/dot/3_node_label.dot
t/in/dot/3_output_lone.dot
t/in/dot/4_cluster_labeljust.dot
t/in/dot/4_compass.dot
t/in/dot/4_html_like.dot
t/in/dot/4_record.dot
t/in/dot/4_strings.dot
t/in/dot/4_uppercase.dot
t/in/dot/5_scope_atr.dot
t/in/dot/5_scopes.dot
t/in/dot/5_scopes_chain.dot
t/in/dot/5_scopes_uni.dot
t/in/dot/6_2_cluster.dot
t/in/dot/6_comments.dot
t/in/dot/6_group_align.dot
t/in/dot/7_record.dot
t/in/dot/9_back.dot
t/in/dot/9_edge_styles.dot
t/in/dot/9_stacking.dot
t/in/dot/9_tree.dot
t/in/gdl/1_color_code.gdl
t/in/gdl/2_bottom_to_top.gdl
t/in/gdl/2_left_to_right.gdl
t/in/gdl/2_right_to_left.gdl
t/in/gdl/2_top_to_bottom.gdl
t/in/README
t/layers.t
t/layout.t
t/layout_r.t
t/layouter.t
t/layouter/edge_label.txt
t/layouter/layouter.txt
t/layouter/layouter_chain.txt
t/layouter/layouter_loop.txt
t/layouter/multiples.txt
t/layouter/state.txt
t/messages.t
t/nesting.t
t/node.t
t/node_mc.t
t/out/0_empty_group.txt
t/out/0_empty_groups.txt
t/out/10_repair.txt
t/out/10borders.txt
t/out/18_multiples.txt
t/out/1_bidi_loop.txt
t/out/1_empty_group.txt
t/out/1_selfloop.txt
t/out/1_selfloop_2.txt
t/out/1_selfloop_label.txt
t/out/1_undirected_loop.txt
t/out/1node.txt
t/out/25_autosplit_empty.txt
t/out/2_autolabel.txt
t/out/2_autosplit_empty.txt
t/out/2_autosplit_escaped.txt
t/out/2_bidi_astar.txt
t/out/2_bidi_endpoint.txt
t/out/2_class.txt
t/out/2_classes.txt
t/out/2_cluster.txt
t/out/2_cluster_2.txt
t/out/2_cluster_3.txt
t/out/2_dot.txt
t/out/2_dot_dot_dash.txt
t/out/2_edges.txt
t/out/2_flow.txt
t/out/2_graph_label.txt
t/out/2_group.txt
t/out/2_group_labelpos.txt
t/out/2_group_multicell.txt
t/out/2_group_no_border.txt
t/out/2_invisible_left.txt
t/out/2_invisible_right.txt
t/out/2_label.txt
t/out/2_label_align.txt
t/out/2_list_attr.txt
t/out/2_long_labels.txt
t/out/2_newlines.txt
t/out/2_nodes_inv.txt
t/out/2_selfloop.txt
t/out/2_selfloop_flow_down.txt
t/out/2_split_bug.txt
t/out/2_wrap.txt
t/out/2_zeros.txt
t/out/2nodes.txt
t/out/3_autosplit_hang.txt
t/out/3_bend_bug.txt
t/out/3_cache_bug.txt
t/out/3_cluster.txt
t/out/3_colors.txt
t/out/3_corrupt.txt
t/out/3_edge_labels_from_class.txt
t/out/3_edge_repair.txt
t/out/3_edge_start.txt
t/out/3_empty_group.txt
t/out/3_flow.txt
t/out/3_group_align_center.txt
t/out/3_inherit.txt
t/out/3_invisible_both.txt
t/out/3_joining.txt
t/out/3_joint.txt
t/out/3_joint_short.txt
t/out/3_list_attr.txt
t/out/3_lists.txt
t/out/3_nodes_5_edges.txt
t/out/3_selfloop.txt
t/out/3_selfloop_flip.txt
t/out/3_selfloop_flow_down.txt
t/out/3_selfloop_flow_left.txt
t/out/3_selfloop_flow_up.txt
t/out/3_split_attribute.txt
t/out/3nodes.txt
t/out/4_2x2nodes.txt
t/out/4_att.txt
t/out/4_autosplit_class.txt
t/out/4_autosplit_empty.txt
t/out/4_autosplit_offset.txt
t/out/4_autosplit_shape.txt
t/out/4_bend_bug.txt
t/out/4_bug_basename.txt
t/out/4_bug_joint_2.txt
t/out/4_collapse.txt
t/out/4_comma.txt
t/out/4_cross.txt
t/out/4_cross_inv.txt
t/out/4_cross_split.txt
t/out/4_cross_split_hor.txt
t/out/4_edge_cross.txt
t/out/4_edge_labels.txt
t/out/4_edge_types.txt
t/out/4_endless_loop.txt
t/out/4_endless_loop_2.txt
t/out/4_flow.txt
t/out/4_flow_chain.txt
t/out/4_invisible.txt
t/out/4_joint.txt
t/out/4_joint_bug_flags.txt
t/out/4_list_attr.txt
t/out/4_lists.txt
t/out/4_minlen.txt
t/out/4_near.txt
t/out/4_node_edge.txt
t/out/4_nodes_5_edges.txt
t/out/4_nodes_6_edges.txt
t/out/4_nodes_edge.txt
t/out/4groups.txt
t/out/4groups_class.txt
t/out/4nodes.txt
t/out/5_a-star_bug.txt
t/out/5_arrow_styles.txt
t/out/5_flow.txt
t/out/5_group_repair.txt
t/out/5_group_split.txt
t/out/5_joint.txt
t/out/5_joint_bug2.txt
t/out/5_joint_label.txt
t/out/5_long_edge_labels.txt
t/out/5_multicell.txt
t/out/5_offsets.txt
t/out/5_offsets_2.txt
t/out/5_rounded.txt
t/out/5_tree_joint.txt
t/out/6_autosplit_class.txt
t/out/6_chain_10_edges.txt
t/out/6_chained.txt
t/out/6_empty_row.txt
t/out/6_fanout.txt
t/out/6_group_align.txt
t/out/6_joint.txt
t/out/6_multicell.txt
t/out/6_multicell_offset.txt
t/out/6_nested_groups.txt
t/out/6_ranks.txt
t/out/6_split_join_loop.txt
t/out/7_cluster.txt
t/out/7_star.txt
t/out/7_tree.txt
t/out/8_align.txt
t/out/8_basename.txt
t/out/8_chain.txt
t/out/8_endless_loop.txt
t/out/8_flow.txt
t/out/8_invisible.txt
t/out/8_labels.txt
t/out/8_optimize_bend.txt
t/out/8_points.txt
t/out/9_chain.txt
t/out/9_cross.txt
t/out/9_flow_south.txt
t/out/dot/0_empty.txt
t/out/dot/10_numbers.txt
t/out/dot/16_split.txt
t/out/dot/2_bool.txt
t/out/dot/2_comment_inside_attr.txt
t/out/dot/2_graph_label_bottom.txt
t/out/dot/2_group_labelloc.txt
t/out/dot/2_ignore.txt
t/out/dot/2_linewidth.txt
t/out/dot/2_no_spaces.txt
t/out/dot/2_nospace.txt
t/out/dot/2_ports.txt
t/out/dot/2_setlinewidth.txt
t/out/dot/2_square_bracket_in_attr.txt
t/out/dot/2_strict.txt
t/out/dot/3_colors.txt
t/out/dot/3_empty_record.txt
t/out/dot/3_empty_record_LR.txt
t/out/dot/3_graph_label_long.txt
t/out/dot/3_ids.txt
t/out/dot/3_invis.txt
t/out/dot/3_node_label.txt
t/out/dot/3_output_lone.txt
t/out/dot/4_cluster_labeljust.txt
t/out/dot/4_compass.txt
t/out/dot/4_html_like.txt
t/out/dot/4_loose.txt
t/out/dot/4_record.txt
t/out/dot/4_strings.txt
t/out/dot/4_uppercase.txt
t/out/dot/5_scope_atr.txt
t/out/dot/5_scopes.txt
t/out/dot/5_scopes_chain.txt
t/out/dot/5_scopes_uni.txt
t/out/dot/6_2_cluster.txt
t/out/dot/6_comments.txt
t/out/dot/6_group_align.txt
t/out/dot/7_record.txt
t/out/dot/9_back.txt
t/out/dot/9_edge_styles.txt
t/out/dot/9_stacking.txt
t/out/dot/9_tree.txt
t/out/drop_result.txt
t/out/gdl/1_color_code.txt
t/out/gdl/2_bottom_to_top.txt
t/out/gdl/2_left_to_right.txt
t/out/gdl/2_right_to_left.txt
t/out/gdl/2_top_to_bottom.txt
t/parse_att.t
t/parse_edge.t
t/parser.t
t/parser_dot.t
t/parser_dot_html.t
t/path.t
t/pod.t
t/pod_cov.t
t/re_layout.t
t/split.t
t/stress/0001.txt
t/stress/0002.txt
t/stress/0003.txt
t/stress/0004.txt
t/stress/0005.txt
t/stress/0006.txt
t/stress/0010.txt
t/stress/0011.txt
t/stress/0012.txt
t/stress/0020.txt
t/stress/anon.txt
t/stress/drop.txt
t/style-trailing-space.t
t/syntax/0000.txt
t/syntax/0001.txt
t/syntax/0002.txt
t/syntax/0003.txt
t/syntax/0010.txt
t/syntax/0011.txt
t/syntax/0020.txt
t/syntax/0021.txt
t/syntax/0030.txt
t/syntax/0040.txt
t/syntax/0050.txt
t/syntax/0060.txt
t/syntax/0061.txt
t/syntax/0062.txt
t/syntax/0063.txt
t/syntax/0070.txt
t/syntax/0080.txt
t/syntax/0090.txt
t/syntax/0100.txt
t/syntax/0102.txt
t/syntax/0110.txt
t/syntax/0120.txt
t/syntax/0130.txt
t/syntax/0131.txt
t/syntax/0140.txt
t/syntax/0150.txt
t/syntax/0160.txt
t/syntax/0170.txt
t/syntax/0171.txt
t/syntax/0180.txt
t/syntax/0190.txt
t/syntax/0200.txt
t/syntax/0210.txt
t/syntax/0220.txt
t/syntax/0230.txt
t/syntax/0240.txt
t/syntax/0250.txt
t/syntax/0251.txt
t/syntax/0252.txt
t/syntax/0254.txt
t/txt/0_empty_group.txt
t/txt/0_empty_groups.txt
t/txt/10_repair.txt
t/txt/10borders.txt
t/txt/18_multiples.txt
t/txt/1_empty_group.txt
t/txt/1_undirected_loop.txt
t/txt/25_autosplit_empty.txt
t/txt/2_autolabel.txt
t/txt/2_autosplit_empty.txt
t/txt/2_autosplit_escaped.txt
t/txt/2_class.txt
t/txt/2_classes.txt
t/txt/2_cluster.txt
t/txt/2_cluster_2.txt
t/txt/2_cluster_3.txt
t/txt/2_dot.txt
t/txt/2_dot_dot_dash.txt
t/txt/2_edges.txt
t/txt/2_flow.txt
t/txt/2_graph_label.txt
t/txt/2_group.txt
t/txt/2_group_labelpos.txt
t/txt/2_group_multicell.txt
t/txt/2_group_no_border.txt
t/txt/2_invisible_left.txt
t/txt/2_invisible_right.txt
t/txt/2_label.txt
t/txt/2_label_align.txt
t/txt/2_list_attr.txt
t/txt/2_long_labels.txt
t/txt/2_newlines.txt
t/txt/2_selfloop.txt
t/txt/2_selfloop_flow_down.txt
t/txt/2_split_bug.txt
t/txt/2_wrap.txt
t/txt/2_zeros.txt
t/txt/2nodes.txt
t/txt/3_autosplit_hang.txt
t/txt/3_cache_bug.txt
t/txt/3_cluster.txt
t/txt/3_colors.txt
t/txt/3_corrupt.txt
t/txt/3_edge_labels_from_class.txt
t/txt/3_edge_repair.txt
t/txt/3_edge_start.txt
t/txt/3_empty_group.txt
t/txt/3_flow.txt
t/txt/3_group_align_center.txt
t/txt/3_inherit.txt
t/txt/3_invisible_both.txt
t/txt/3_joining.txt
t/txt/3_joint.txt
t/txt/3_joint_short.txt
t/txt/3_list_attr.txt
t/txt/3_lists.txt
t/txt/3_nodes_5_edges.txt
t/txt/3_selfloop.txt
t/txt/3_selfloop_flip.txt
t/txt/3_selfloop_flow_down.txt
t/txt/3_selfloop_flow_left.txt
t/txt/3_selfloop_flow_up.txt
t/txt/3_split_attribute.txt
t/txt/3nodes.txt
t/txt/4_2x2nodes.txt
t/txt/4_att.txt
t/txt/4_autosplit_class.txt
t/txt/4_autosplit_empty.txt
t/txt/4_autosplit_offset.txt
t/txt/4_autosplit_shape.txt
t/txt/4_bug_basename.txt
t/txt/4_bug_joint_2.txt
t/txt/4_collapse.txt
t/txt/4_comma.txt
t/txt/4_cross.txt
t/txt/4_cross_inv.txt
t/txt/4_cross_split.txt
t/txt/4_cross_split_hor.txt
t/txt/4_edge_cross.txt
t/txt/4_edge_labels.txt
t/txt/4_edge_types.txt
t/txt/4_endless_loop.txt
t/txt/4_endless_loop_2.txt
t/txt/4_flow.txt
t/txt/4_flow_chain.txt
t/txt/4_invisible.txt
t/txt/4_joint.txt
t/txt/4_joint_bug_flags.txt
t/txt/4_list_attr.txt
t/txt/4_lists.txt
t/txt/4_minlen.txt
t/txt/4_near.txt
t/txt/4_node_edge.txt
t/txt/4_nodes_5_edges.txt
t/txt/4_nodes_6_edges.txt
t/txt/4_nodes_edge.txt
t/txt/4groups.txt
t/txt/4groups_class.txt
t/txt/4nodes.txt
t/txt/5_arrow_styles.txt
t/txt/5_flow.txt
t/txt/5_group_repair.txt
t/txt/5_group_split.txt
t/txt/5_joint.txt
t/txt/5_joint_bug2.txt
t/txt/5_joint_label.txt
t/txt/5_long_edge_labels.txt
t/txt/5_multicell.txt
t/txt/5_offsets.txt
t/txt/5_offsets_2.txt
t/txt/5_rounded.txt
t/txt/5_tree_joint.txt
t/txt/6_autosplit_class.txt
t/txt/6_chain_10_edges.txt
t/txt/6_chained.txt
t/txt/6_empty_row.txt
t/txt/6_fanout.txt
t/txt/6_group_align.txt
t/txt/6_joint.txt
t/txt/6_multicell.txt
t/txt/6_multicell_offset.txt
t/txt/6_nested_groups.txt
t/txt/6_ranks.txt
t/txt/6_split_join_loop.txt
t/txt/7_cluster.txt
t/txt/7_star.txt
t/txt/7_tree.txt
t/txt/8_align.txt
t/txt/8_basename.txt
t/txt/8_chain.txt
t/txt/8_endless_loop.txt
t/txt/8_flow.txt
t/txt/8_invisible.txt
t/txt/8_labels.txt
t/txt/8_optimize_bend.txt
t/txt/8_points.txt
t/txt/9_chain.txt
t/txt/9_cross.txt
t/txt/9_flow_south.txt
t/txt/dot/0_empty.txt
t/txt/dot/10_numbers.txt
t/txt/dot/16_split.txt
t/txt/dot/2_bool.txt
t/txt/dot/2_comment_inside_attr.txt
t/txt/dot/2_graph_label_bottom.txt
t/txt/dot/2_group_labelloc.txt
t/txt/dot/2_ignore.txt
t/txt/dot/2_linewidth.txt
t/txt/dot/2_no_spaces.txt
t/txt/dot/2_nospace.txt
t/txt/dot/2_ports.txt
t/txt/dot/2_setlinewidth.txt
t/txt/dot/2_square_bracket_in_attr.txt
t/txt/dot/2_strict.txt
t/txt/dot/3_colors.txt
t/txt/dot/3_empty_record.txt
t/txt/dot/3_empty_record_LR.txt
t/txt/dot/3_graph_label_long.txt
t/txt/dot/3_ids.txt
t/txt/dot/3_invis.txt
t/txt/dot/3_node_label.txt
t/txt/dot/3_output_lone.txt
t/txt/dot/4_cluster_labeljust.txt
t/txt/dot/4_compass.txt
t/txt/dot/4_html_like.txt
t/txt/dot/4_loose.txt
t/txt/dot/4_record.txt
t/txt/dot/4_strings.txt
t/txt/dot/4_uppercase.txt
t/txt/dot/5_scope_atr.txt
t/txt/dot/5_scopes.txt
t/txt/dot/5_scopes_chain.txt
t/txt/dot/5_scopes_uni.txt
t/txt/dot/6_2_cluster.txt
t/txt/dot/6_comments.txt
t/txt/dot/6_group_align.txt
t/txt/dot/7_record.txt
t/txt/dot/9_back.txt
t/txt/dot/9_edge_styles.txt
t/txt/dot/9_stacking.txt
t/txt/dot/9_tree.txt
t/txt/gdl/1_color_code.txt
t/txt/gdl/2_bottom_to_top.txt
t/txt/gdl/2_left_to_right.txt
t/txt/gdl/2_right_to_left.txt
t/txt/gdl/2_top_to_bottom.txt
t/use_class.t
t/vcg.t
TODO

20
perl/lib/Graph-Easy-0.76/MANIFEST.SKIP Normal file
View File

@@ -0,0 +1,20 @@
^Build\z
^_build/
^blib.*
^fun\z
^gdl
^Graph-Easy-[0-9]
^Makefile.(old|bak)\z
^Makefile\z
^MYMETA\.yml\z
^MYMETA\.json\z
^[^\\\/]*\.pl
pm_to_blib
\.svn
.*\.tar\.gz
tmon.out
^todos[\\\/]
^[\w\._-]+\.(html|txt|png|gif|dot|pl|svg|old|bak|org|vcg|gdl|ps|graphml)
^wikicrawl
~\z
.*\.swp

177
perl/lib/Graph-Easy-0.76/META.json Normal file
View File

@@ -0,0 +1,177 @@
{
"abstract" : "Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)",
"author" : [
"unknown"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4218",
"keywords" : [
"generation",
"graph",
"graphviz",
"text generation",
"text"
],
"license" : [
"gpl_1"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Graph-Easy",
"prereqs" : {
"build" : {
"requires" : {
"Test::More" : "0.62"
}
},
"configure" : {
"requires" : {
"Module::Build" : "0.36"
}
},
"runtime" : {
"recommends" : {
"Graph::Easy::As_svg" : "0.23"
},
"requires" : {
"Scalar::Util" : "1.13",
"perl" : "v5.8.2",
"strict" : "0",
"vars" : "0",
"warnings" : "0"
}
}
},
"provides" : {
"Graph::Easy" : {
"file" : "lib/Graph/Easy.pm",
"version" : "0.76"
},
"Graph::Easy::As_ascii" : {
"file" : "lib/Graph/Easy/As_ascii.pm",
"version" : "0.76"
},
"Graph::Easy::As_graphml" : {
"file" : "lib/Graph/Easy/As_graphml.pm",
"version" : "0.76"
},
"Graph::Easy::As_graphviz" : {
"file" : "lib/Graph/Easy/As_graphviz.pm",
"version" : "0.76"
},
"Graph::Easy::As_txt" : {
"file" : "lib/Graph/Easy/As_txt.pm",
"version" : "0.76"
},
"Graph::Easy::As_vcg" : {
"file" : "lib/Graph/Easy/As_vcg.pm",
"version" : "0.76"
},
"Graph::Easy::Attributes" : {
"file" : "lib/Graph/Easy/Attributes.pm",
"version" : "0.76"
},
"Graph::Easy::Base" : {
"file" : "lib/Graph/Easy/Base.pm",
"version" : "0.76"
},
"Graph::Easy::Edge" : {
"file" : "lib/Graph/Easy/Edge.pm",
"version" : "0.76"
},
"Graph::Easy::Edge::Cell" : {
"file" : "lib/Graph/Easy/Edge/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Edge::Cell::Empty" : {
"file" : "lib/Graph/Easy/Edge/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Group" : {
"file" : "lib/Graph/Easy/Group.pm",
"version" : "0.76"
},
"Graph::Easy::Group::Anon" : {
"file" : "lib/Graph/Easy/Group/Anon.pm",
"version" : "0.76"
},
"Graph::Easy::Group::Cell" : {
"file" : "lib/Graph/Easy/Group/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Heap" : {
"file" : "lib/Graph/Easy/Layout/Scout.pm"
},
"Graph::Easy::Layout" : {
"file" : "lib/Graph/Easy/Layout.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Chain" : {
"file" : "lib/Graph/Easy/Layout/Chain.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Force" : {
"file" : "lib/Graph/Easy/Layout/Force.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Grid" : {
"file" : "lib/Graph/Easy/Layout/Grid.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Path" : {
"file" : "lib/Graph/Easy/Layout/Path.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Repair" : {
"file" : "lib/Graph/Easy/Layout/Repair.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Scout" : {
"file" : "lib/Graph/Easy/Layout/Scout.pm",
"version" : "0.76"
},
"Graph::Easy::Node" : {
"file" : "lib/Graph/Easy/Node.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Anon" : {
"file" : "lib/Graph/Easy/Node/Anon.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Cell" : {
"file" : "lib/Graph/Easy/Node/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Empty" : {
"file" : "lib/Graph/Easy/Node/Empty.pm",
"version" : "0.76"
},
"Graph::Easy::Parser" : {
"file" : "lib/Graph/Easy/Parser.pm",
"version" : "0.76"
},
"Graph::Easy::Parser::Graphviz" : {
"file" : "lib/Graph/Easy/Parser/Graphviz.pm",
"version" : "0.76"
},
"Graph::Easy::Parser::VCG" : {
"file" : "lib/Graph/Easy/Parser/VCG.pm",
"version" : "0.76"
},
"Graph::Easy::Util" : {
"file" : "lib/Graph/Easy/Util.pm"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt"
],
"repository" : {
"url" : "https://bitbucket.org/shlomif/perl-graph-easy"
}
},
"version" : "0.76"
}

122
perl/lib/Graph-Easy-0.76/META.yml Normal file
View File

@@ -0,0 +1,122 @@
---
abstract: 'Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)'
author:
- unknown
build_requires:
Test::More: '0.62'
configure_requires:
Module::Build: '0.36'
dynamic_config: 1
generated_by: 'Module::Build version 0.4218, CPAN::Meta::Converter version 2.150001'
keywords:
- generation
- graph
- graphviz
- 'text generation'
- text
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Graph-Easy
provides:
Graph::Easy:
file: lib/Graph/Easy.pm
version: '0.76'
Graph::Easy::As_ascii:
file: lib/Graph/Easy/As_ascii.pm
version: '0.76'
Graph::Easy::As_graphml:
file: lib/Graph/Easy/As_graphml.pm
version: '0.76'
Graph::Easy::As_graphviz:
file: lib/Graph/Easy/As_graphviz.pm
version: '0.76'
Graph::Easy::As_txt:
file: lib/Graph/Easy/As_txt.pm
version: '0.76'
Graph::Easy::As_vcg:
file: lib/Graph/Easy/As_vcg.pm
version: '0.76'
Graph::Easy::Attributes:
file: lib/Graph/Easy/Attributes.pm
version: '0.76'
Graph::Easy::Base:
file: lib/Graph/Easy/Base.pm
version: '0.76'
Graph::Easy::Edge:
file: lib/Graph/Easy/Edge.pm
version: '0.76'
Graph::Easy::Edge::Cell:
file: lib/Graph/Easy/Edge/Cell.pm
version: '0.76'
Graph::Easy::Edge::Cell::Empty:
file: lib/Graph/Easy/Edge/Cell.pm
version: '0.76'
Graph::Easy::Group:
file: lib/Graph/Easy/Group.pm
version: '0.76'
Graph::Easy::Group::Anon:
file: lib/Graph/Easy/Group/Anon.pm
version: '0.76'
Graph::Easy::Group::Cell:
file: lib/Graph/Easy/Group/Cell.pm
version: '0.76'
Graph::Easy::Heap:
file: lib/Graph/Easy/Layout/Scout.pm
Graph::Easy::Layout:
file: lib/Graph/Easy/Layout.pm
version: '0.76'
Graph::Easy::Layout::Chain:
file: lib/Graph/Easy/Layout/Chain.pm
version: '0.76'
Graph::Easy::Layout::Force:
file: lib/Graph/Easy/Layout/Force.pm
version: '0.76'
Graph::Easy::Layout::Grid:
file: lib/Graph/Easy/Layout/Grid.pm
version: '0.76'
Graph::Easy::Layout::Path:
file: lib/Graph/Easy/Layout/Path.pm
version: '0.76'
Graph::Easy::Layout::Repair:
file: lib/Graph/Easy/Layout/Repair.pm
version: '0.76'
Graph::Easy::Layout::Scout:
file: lib/Graph/Easy/Layout/Scout.pm
version: '0.76'
Graph::Easy::Node:
file: lib/Graph/Easy/Node.pm
version: '0.76'
Graph::Easy::Node::Anon:
file: lib/Graph/Easy/Node/Anon.pm
version: '0.76'
Graph::Easy::Node::Cell:
file: lib/Graph/Easy/Node/Cell.pm
version: '0.76'
Graph::Easy::Node::Empty:
file: lib/Graph/Easy/Node/Empty.pm
version: '0.76'
Graph::Easy::Parser:
file: lib/Graph/Easy/Parser.pm
version: '0.76'
Graph::Easy::Parser::Graphviz:
file: lib/Graph/Easy/Parser/Graphviz.pm
version: '0.76'
Graph::Easy::Parser::VCG:
file: lib/Graph/Easy/Parser/VCG.pm
version: '0.76'
Graph::Easy::Util:
file: lib/Graph/Easy/Util.pm
recommends:
Graph::Easy::As_svg: '0.23'
requires:
Scalar::Util: '1.13'
perl: v5.8.2
strict: '0'
vars: '0'
warnings: '0'
resources:
license: http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt
repository: https://bitbucket.org/shlomif/perl-graph-easy
version: '0.76'

178
perl/lib/Graph-Easy-0.76/MYMETA.json Normal file
View File

@@ -0,0 +1,178 @@
{
"abstract" : "Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)",
"author" : [
"unknown"
],
"dynamic_config" : 0,
"generated_by" : "Module::Build version 0.4218, CPAN::Meta::Converter version 2.150010",
"keywords" : [
"generation",
"graph",
"graphviz",
"text generation",
"text"
],
"license" : [
"gpl_1"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Graph-Easy",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"recommends" : {
"Graph::Easy::As_svg" : "0.23"
},
"requires" : {
"Scalar::Util" : "1.13",
"Test::More" : "0.62",
"strict" : "0",
"vars" : "0",
"warnings" : "0"
}
}
},
"provides" : {
"Graph::Easy" : {
"file" : "lib/Graph/Easy.pm",
"version" : "0.76"
},
"Graph::Easy::As_ascii" : {
"file" : "lib/Graph/Easy/As_ascii.pm",
"version" : "0.76"
},
"Graph::Easy::As_graphml" : {
"file" : "lib/Graph/Easy/As_graphml.pm",
"version" : "0.76"
},
"Graph::Easy::As_graphviz" : {
"file" : "lib/Graph/Easy/As_graphviz.pm",
"version" : "0.76"
},
"Graph::Easy::As_txt" : {
"file" : "lib/Graph/Easy/As_txt.pm",
"version" : "0.76"
},
"Graph::Easy::As_vcg" : {
"file" : "lib/Graph/Easy/As_vcg.pm",
"version" : "0.76"
},
"Graph::Easy::Attributes" : {
"file" : "lib/Graph/Easy/Attributes.pm",
"version" : "0.76"
},
"Graph::Easy::Base" : {
"file" : "lib/Graph/Easy/Base.pm",
"version" : "0.76"
},
"Graph::Easy::Edge" : {
"file" : "lib/Graph/Easy/Edge.pm",
"version" : "0.76"
},
"Graph::Easy::Edge::Cell" : {
"file" : "lib/Graph/Easy/Edge/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Edge::Cell::Empty" : {
"file" : "lib/Graph/Easy/Edge/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Group" : {
"file" : "lib/Graph/Easy/Group.pm",
"version" : "0.76"
},
"Graph::Easy::Group::Anon" : {
"file" : "lib/Graph/Easy/Group/Anon.pm",
"version" : "0.76"
},
"Graph::Easy::Group::Cell" : {
"file" : "lib/Graph/Easy/Group/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Heap" : {
"file" : "lib/Graph/Easy/Layout/Scout.pm"
},
"Graph::Easy::Layout" : {
"file" : "lib/Graph/Easy/Layout.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Chain" : {
"file" : "lib/Graph/Easy/Layout/Chain.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Force" : {
"file" : "lib/Graph/Easy/Layout/Force.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Grid" : {
"file" : "lib/Graph/Easy/Layout/Grid.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Path" : {
"file" : "lib/Graph/Easy/Layout/Path.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Repair" : {
"file" : "lib/Graph/Easy/Layout/Repair.pm",
"version" : "0.76"
},
"Graph::Easy::Layout::Scout" : {
"file" : "lib/Graph/Easy/Layout/Scout.pm",
"version" : "0.76"
},
"Graph::Easy::Node" : {
"file" : "lib/Graph/Easy/Node.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Anon" : {
"file" : "lib/Graph/Easy/Node/Anon.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Cell" : {
"file" : "lib/Graph/Easy/Node/Cell.pm",
"version" : "0.76"
},
"Graph::Easy::Node::Empty" : {
"file" : "lib/Graph/Easy/Node/Empty.pm",
"version" : "0.76"
},
"Graph::Easy::Parser" : {
"file" : "lib/Graph/Easy/Parser.pm",
"version" : "0.76"
},
"Graph::Easy::Parser::Graphviz" : {
"file" : "lib/Graph/Easy/Parser/Graphviz.pm",
"version" : "0.76"
},
"Graph::Easy::Parser::VCG" : {
"file" : "lib/Graph/Easy/Parser/VCG.pm",
"version" : "0.76"
},
"Graph::Easy::Util" : {
"file" : "lib/Graph/Easy/Util.pm"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt"
],
"repository" : {
"url" : "https://bitbucket.org/shlomif/perl-graph-easy"
}
},
"version" : "0.76",
"x_serialization_backend" : "JSON::PP version 4.02"
}

123
perl/lib/Graph-Easy-0.76/MYMETA.yml Normal file
View File

@@ -0,0 +1,123 @@
---
abstract: 'Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)'
author:
- unknown
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Module::Build version 0.4218, CPAN::Meta::Converter version 2.150010'
keywords:
- generation
- graph
- graphviz
- 'text generation'
- text
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Graph-Easy
provides:
Graph::Easy:
file: lib/Graph/Easy.pm
version: '0.76'
Graph::Easy::As_ascii:
file: lib/Graph/Easy/As_ascii.pm
version: '0.76'
Graph::Easy::As_graphml:
file: lib/Graph/Easy/As_graphml.pm
version: '0.76'
Graph::Easy::As_graphviz:
file: lib/Graph/Easy/As_graphviz.pm
version: '0.76'
Graph::Easy::As_txt:
file: lib/Graph/Easy/As_txt.pm
version: '0.76'
Graph::Easy::As_vcg:
file: lib/Graph/Easy/As_vcg.pm
version: '0.76'
Graph::Easy::Attributes:
file: lib/Graph/Easy/Attributes.pm
version: '0.76'
Graph::Easy::Base:
file: lib/Graph/Easy/Base.pm
version: '0.76'
Graph::Easy::Edge:
file: lib/Graph/Easy/Edge.pm
version: '0.76'
Graph::Easy::Edge::Cell:
file: lib/Graph/Easy/Edge/Cell.pm
version: '0.76'
Graph::Easy::Edge::Cell::Empty:
file: lib/Graph/Easy/Edge/Cell.pm
version: '0.76'
Graph::Easy::Group:
file: lib/Graph/Easy/Group.pm
version: '0.76'
Graph::Easy::Group::Anon:
file: lib/Graph/Easy/Group/Anon.pm
version: '0.76'
Graph::Easy::Group::Cell:
file: lib/Graph/Easy/Group/Cell.pm
version: '0.76'
Graph::Easy::Heap:
file: lib/Graph/Easy/Layout/Scout.pm
Graph::Easy::Layout:
file: lib/Graph/Easy/Layout.pm
version: '0.76'
Graph::Easy::Layout::Chain:
file: lib/Graph/Easy/Layout/Chain.pm
version: '0.76'
Graph::Easy::Layout::Force:
file: lib/Graph/Easy/Layout/Force.pm
version: '0.76'
Graph::Easy::Layout::Grid:
file: lib/Graph/Easy/Layout/Grid.pm
version: '0.76'
Graph::Easy::Layout::Path:
file: lib/Graph/Easy/Layout/Path.pm
version: '0.76'
Graph::Easy::Layout::Repair:
file: lib/Graph/Easy/Layout/Repair.pm
version: '0.76'
Graph::Easy::Layout::Scout:
file: lib/Graph/Easy/Layout/Scout.pm
version: '0.76'
Graph::Easy::Node:
file: lib/Graph/Easy/Node.pm
version: '0.76'
Graph::Easy::Node::Anon:
file: lib/Graph/Easy/Node/Anon.pm
version: '0.76'
Graph::Easy::Node::Cell:
file: lib/Graph/Easy/Node/Cell.pm
version: '0.76'
Graph::Easy::Node::Empty:
file: lib/Graph/Easy/Node/Empty.pm
version: '0.76'
Graph::Easy::Parser:
file: lib/Graph/Easy/Parser.pm
version: '0.76'
Graph::Easy::Parser::Graphviz:
file: lib/Graph/Easy/Parser/Graphviz.pm
version: '0.76'
Graph::Easy::Parser::VCG:
file: lib/Graph/Easy/Parser/VCG.pm
version: '0.76'
Graph::Easy::Util:
file: lib/Graph/Easy/Util.pm
recommends:
Graph::Easy::As_svg: '0.23'
requires:
Scalar::Util: '1.13'
Test::More: '0.62'
strict: '0'
vars: '0'
warnings: '0'
resources:
license: http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt
repository: https://bitbucket.org/shlomif/perl-graph-easy
version: '0.76'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

982
perl/lib/Graph-Easy-0.76/Makefile Normal file
View File

@@ -0,0 +1,982 @@
# This Makefile is for the Graph::Easy extension to perl.
#
# It was generated automatically by MakeMaker version
# 7.36 (Revision: 73600) from the contents of
# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
# MakeMaker ARGV: ()
#
# MakeMaker Parameters:
# BUILD_REQUIRES => { }
# CONFIGURE_REQUIRES => { }
# EXE_FILES => [q[bin/graph-easy]]
# INSTALLDIRS => q[site]
# NAME => q[Graph::Easy]
# PL_FILES => { }
# PREREQ_PM => { Scalar::Util=>q[1.13], Test::More=>q[0.62], strict=>q[0], vars=>q[0], warnings=>q[0] }
# TEST_REQUIRES => { }
# VERSION_FROM => q[lib/Graph/Easy.pm]
# --- MakeMaker post_initialize section:
# --- MakeMaker const_config section:
SHELL = C:\windows\system32\cmd.exe
# These definitions are from config.sh (via C:/Strawberry/perl/lib/Config.pm).
# They may have been overridden via Makefile.PL or on the command line.
AR = ar
CC = gcc
CCCDLFLAGS =
CCDLFLAGS =
DLEXT = xs.dll
DLSRC = dl_win32.xs
EXE_EXT = .exe
FULL_AR =
LD = g++
LDDLFLAGS = -mdll -s -L"C:\STRAWB~1\perl\lib\CORE" -L"C:\STRAWB~1\c\lib"
LDFLAGS = -s -L"C:\STRAWB~1\perl\lib\CORE" -L"C:\STRAWB~1\c\lib"
LIBC =
LIB_EXT = .a
OBJ_EXT = .o
OSNAME = MSWin32
OSVERS = 10.0.17763.529
RANLIB = rem
SITELIBEXP = C:\STRAWB~1\perl\site\lib
SITEARCHEXP = C:\STRAWB~1\perl\site\lib
SO = dll
VENDORARCHEXP = C:\STRAWB~1\perl\vendor\lib
VENDORLIBEXP = C:\STRAWB~1\perl\vendor\lib
# --- MakeMaker constants section:
AR_STATIC_ARGS = cr
DIRFILESEP = /
DFSEP = $(DIRFILESEP)
NAME = Graph::Easy
NAME_SYM = Graph_Easy
VERSION = 0.76
VERSION_MACRO = VERSION
VERSION_SYM = 0_76
DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
XS_VERSION = 0.76
XS_VERSION_MACRO = XS_VERSION
XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
INST_ARCHLIB = blib\arch
INST_SCRIPT = blib\script
INST_BIN = blib\bin
INST_LIB = blib\lib
INST_MAN1DIR = blib\man1
INST_MAN3DIR = blib\man3
MAN1EXT = 1
MAN3EXT = 3
INSTALLDIRS = site
DESTDIR =
PREFIX = $(SITEPREFIX)
PERLPREFIX = C:\STRAWB~1\perl
SITEPREFIX = C:\STRAWB~1\perl\site
VENDORPREFIX = C:\STRAWB~1\perl\vendor
INSTALLPRIVLIB = C:\STRAWB~1\perl\lib
DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
INSTALLSITELIB = C:\STRAWB~1\perl\site\lib
DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
INSTALLVENDORLIB = C:\STRAWB~1\perl\vendor\lib
DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
INSTALLARCHLIB = C:\STRAWB~1\perl\lib
DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
INSTALLSITEARCH = C:\STRAWB~1\perl\site\lib
DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
INSTALLVENDORARCH = C:\STRAWB~1\perl\vendor\lib
DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
INSTALLBIN = C:\STRAWB~1\perl\bin
DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
INSTALLSITEBIN = C:\STRAWB~1\perl\site\bin
DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
INSTALLVENDORBIN = C:\STRAWB~1\perl\bin
DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
INSTALLSCRIPT = C:\STRAWB~1\perl\bin
DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
INSTALLSITESCRIPT = C:\STRAWB~1\perl\site\bin
DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
INSTALLVENDORSCRIPT = C:\STRAWB~1\perl\bin
DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
INSTALLMAN1DIR = none
DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
INSTALLSITEMAN1DIR = $(INSTALLMAN1DIR)
DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
INSTALLVENDORMAN1DIR = $(INSTALLMAN1DIR)
DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
INSTALLMAN3DIR = none
DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
INSTALLSITEMAN3DIR = $(INSTALLMAN3DIR)
DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
INSTALLVENDORMAN3DIR = $(INSTALLMAN3DIR)
DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
PERL_LIB = C:\STRAWB~1\perl\lib
PERL_ARCHLIB = C:\STRAWB~1\perl\lib
PERL_ARCHLIBDEP = C:\STRAWB~1\perl\lib
LIBPERL_A = libperl.a
FIRST_MAKEFILE = Makefile
MAKEFILE_OLD = Makefile.old
MAKE_APERL_FILE = Makefile.aperl
PERLMAINCC = $(CC)
PERL_INC = C:\STRAWB~1\perl\lib\CORE
PERL_INCDEP = C:\STRAWB~1\perl\lib\CORE
PERL = "C:\Strawberry\perl\bin\perl.exe"
FULLPERL = "C:\Strawberry\perl\bin\perl.exe"
ABSPERL = $(PERL)
PERLRUN = $(PERL)
FULLPERLRUN = $(FULLPERL)
ABSPERLRUN = $(ABSPERL)
PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
PERL_CORE = 0
PERM_DIR = 755
PERM_RW = 644
PERM_RWX = 755
MAKEMAKER = C:/Strawberry/perl/lib/ExtUtils/MakeMaker.pm
MM_VERSION = 7.36
MM_REVISION = 73600
# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
MAKE = gmake
FULLEXT = Graph\Easy
BASEEXT = Easy
PARENT_NAME = Graph
DLBASE = $(BASEEXT)
VERSION_FROM = lib/Graph/Easy.pm
OBJECT =
LDFROM = $(OBJECT)
LINKTYPE = dynamic
BOOTDEP =
# Handy lists of source code files:
XS_FILES =
C_FILES =
O_FILES =
H_FILES =
MAN1PODS =
MAN3PODS =
# Where is the Config information that we are using/depend on
CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h
# Where to build things
INST_LIBDIR = $(INST_LIB)\Graph
INST_ARCHLIBDIR = $(INST_ARCHLIB)\Graph
INST_AUTODIR = $(INST_LIB)\auto\$(FULLEXT)
INST_ARCHAUTODIR = $(INST_ARCHLIB)\auto\$(FULLEXT)
INST_STATIC =
INST_DYNAMIC =
INST_BOOT =
# Extra linker info
EXPORT_LIST = $(BASEEXT).def
PERL_ARCHIVE = $(PERL_INC)\libperl530.a
PERL_ARCHIVEDEP = $(PERL_INCDEP)\libperl530.a
PERL_ARCHIVE_AFTER =
TO_INST_PM = lib/Graph/Easy.pm \
lib/Graph/Easy/As_ascii.pm \
lib/Graph/Easy/As_graphml.pm \
lib/Graph/Easy/As_graphviz.pm \
lib/Graph/Easy/As_txt.pm \
lib/Graph/Easy/As_vcg.pm \
lib/Graph/Easy/Attributes.pm \
lib/Graph/Easy/Base.pm \
lib/Graph/Easy/Edge.pm \
lib/Graph/Easy/Edge/Cell.pm \
lib/Graph/Easy/Group.pm \
lib/Graph/Easy/Group/Anon.pm \
lib/Graph/Easy/Group/Cell.pm \
lib/Graph/Easy/Layout.pm \
lib/Graph/Easy/Layout/Chain.pm \
lib/Graph/Easy/Layout/Force.pm \
lib/Graph/Easy/Layout/Grid.pm \
lib/Graph/Easy/Layout/Path.pm \
lib/Graph/Easy/Layout/Repair.pm \
lib/Graph/Easy/Layout/Scout.pm \
lib/Graph/Easy/Node.pm \
lib/Graph/Easy/Node/Anon.pm \
lib/Graph/Easy/Node/Cell.pm \
lib/Graph/Easy/Node/Empty.pm \
lib/Graph/Easy/Parser.pm \
lib/Graph/Easy/Parser/Graphviz.pm \
lib/Graph/Easy/Parser/VCG.pm \
lib/Graph/Easy/Util.pm
# --- MakeMaker platform_constants section:
MM_Win32_VERSION = 7.36
# --- MakeMaker tool_autosplit section:
# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
AUTOSPLITFILE = $(ABSPERLRUN) -e "use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)" --
# --- MakeMaker tool_xsubpp section:
# --- MakeMaker tools_other section:
CHMOD = $(ABSPERLRUN) -MExtUtils::Command -e chmod --
CP = $(ABSPERLRUN) -MExtUtils::Command -e cp --
MV = $(ABSPERLRUN) -MExtUtils::Command -e mv --
NOOP = rem
NOECHO = @
RM_F = $(ABSPERLRUN) -MExtUtils::Command -e rm_f --
RM_RF = $(ABSPERLRUN) -MExtUtils::Command -e rm_rf --
TEST_F = $(ABSPERLRUN) -MExtUtils::Command -e test_f --
TOUCH = $(ABSPERLRUN) -MExtUtils::Command -e touch --
UMASK_NULL = umask 0
DEV_NULL = > NUL
MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e mkpath --
EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e eqtime --
FALSE = $(ABSPERLRUN) -e "exit 1" --
TRUE = $(ABSPERLRUN) -e "exit 0" --
ECHO = $(ABSPERLRUN) -l -e "binmode STDOUT, qq{:raw}; print qq{@ARGV}" --
ECHO_N = $(ABSPERLRUN) -e "print qq{@ARGV}" --
UNINST = 0
VERBINST = 0
MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e "install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);" --
DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e perllocal_install --
UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e uninstall --
WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e warn_if_old_packlist --
MACROSTART =
MACROEND =
USEMAKEFILE = -f
FIXIN = pl2bat.bat
CP_NONEMPTY = $(ABSPERLRUN) -MExtUtils::Command::MM -e cp_nonempty --
# --- MakeMaker makemakerdflt section:
makemakerdflt : all
$(NOECHO) $(NOOP)
# --- MakeMaker dist section:
TAR = tar
TARFLAGS = cvf
ZIP = zip
ZIPFLAGS = -r
COMPRESS = gzip --best
SUFFIX = .gz
SHAR = shar
PREOP = $(NOECHO) $(NOOP)
POSTOP = $(NOECHO) $(NOOP)
TO_UNIX = $(NOECHO) $(NOOP)
CI = ci -u
RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
DIST_CP = best
DIST_DEFAULT = tardist
DISTNAME = Graph-Easy
DISTVNAME = Graph-Easy-0.76
# --- MakeMaker macro section:
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
# --- MakeMaker const_loadlibs section:
# --- MakeMaker const_cccmd section:
# --- MakeMaker post_constants section:
# --- MakeMaker pasthru section:
PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
LINKTYPE="$(LINKTYPE)"\
PREFIX="$(PREFIX)"\
PASTHRU_DEFINE="$(DEFINE) $(PASTHRU_DEFINE)"\
PASTHRU_INC="$(INC) $(PASTHRU_INC)"
# --- MakeMaker special_targets section:
.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static
# --- MakeMaker c_o section:
# --- MakeMaker xs_c section:
# --- MakeMaker xs_o section:
# --- MakeMaker top_targets section:
all :: pure_all
$(NOECHO) $(NOOP)
pure_all :: config pm_to_blib subdirs linkext
$(NOECHO) $(NOOP)
$(NOECHO) $(NOOP)
subdirs :: $(MYEXTLIB)
$(NOECHO) $(NOOP)
config :: $(FIRST_MAKEFILE) blibdirs
$(NOECHO) $(NOOP)
help :
perldoc ExtUtils::MakeMaker
# --- MakeMaker blibdirs section:
blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
$(NOECHO) $(NOOP)
# Backwards compat with 6.18 through 6.25
blibdirs.ts : blibdirs
$(NOECHO) $(NOOP)
$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_LIBDIR)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR)
$(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHLIB)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB)
$(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_AUTODIR)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR)
$(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR)
$(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
$(INST_BIN)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_BIN)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN)
$(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_SCRIPT)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT)
$(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN1DIR)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR)
$(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN3DIR)
$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR)
$(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
# --- MakeMaker linkext section:
linkext :: dynamic
$(NOECHO) $(NOOP)
# --- MakeMaker dlsyms section:
Easy.def: Makefile.PL
$(PERLRUN) -MExtUtils::Mksymlists \
-e "Mksymlists('NAME'=>\"Graph::Easy\", 'DLBASE' => '$(BASEEXT)', 'DL_FUNCS' => { }, 'FUNCLIST' => [], 'IMPORTS' => { }, 'DL_VARS' => []);"
# --- MakeMaker dynamic_bs section:
BOOTSTRAP =
# --- MakeMaker dynamic section:
dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(INST_DYNAMIC)
$(NOECHO) $(NOOP)
# --- MakeMaker dynamic_lib section:
# --- MakeMaker static section:
## $(INST_PM) has been moved to the all: target.
## It remains here for awhile to allow for old usage: "make static"
static :: $(FIRST_MAKEFILE) $(INST_STATIC)
$(NOECHO) $(NOOP)
# --- MakeMaker static_lib section:
# --- MakeMaker manifypods section:
POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
POD2MAN = $(POD2MAN_EXE)
manifypods : pure_all config
$(NOECHO) $(NOOP)
# --- MakeMaker processPL section:
# --- MakeMaker installbin section:
EXE_FILES = bin/graph-easy
pure_all :: $(INST_SCRIPT)\graph-easy
$(NOECHO) $(NOOP)
realclean ::
$(RM_F) \
$(INST_SCRIPT)\graph-easy
$(INST_SCRIPT)\graph-easy : bin/graph-easy $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
$(NOECHO) $(RM_F) $(INST_SCRIPT)\graph-easy
$(CP) bin/graph-easy $(INST_SCRIPT)\graph-easy
$(FIXIN) $(INST_SCRIPT)\graph-easy
-$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)\graph-easy
# --- MakeMaker subdirs section:
# none
# --- MakeMaker clean_subdirs section:
clean_subdirs :
$(NOECHO) $(NOOP)
# --- MakeMaker clean section:
# Delete temporary files but do not touch installed files. We don't delete
# the Makefile here so a later make realclean still has a makefile to use.
clean :: clean_subdirs
- $(RM_F) \
$(BASEEXT).bso $(BASEEXT).def \
$(BASEEXT).exp $(BASEEXT).x \
$(BOOTSTRAP) $(INST_ARCHAUTODIR)\extralibs.all \
$(INST_ARCHAUTODIR)\extralibs.ld $(MAKE_APERL_FILE) \
*$(LIB_EXT) *$(OBJ_EXT) \
*perl.core MYMETA.json \
MYMETA.yml blibdirs.ts \
core core.*perl.*.? \
core.[0-9] core.[0-9][0-9] \
core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] \
core.[0-9][0-9][0-9][0-9][0-9] lib$(BASEEXT).def \
mon.out perl \
perl$(EXE_EXT) perl.exe \
perlmain.c pm_to_blib \
pm_to_blib.ts so_locations \
tmon.out
- $(RM_RF) \
blib dll.base \
dll.exp
$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
# --- MakeMaker realclean_subdirs section:
# so clean is forced to complete before realclean_subdirs runs
realclean_subdirs : clean
$(NOECHO) $(NOOP)
# --- MakeMaker realclean section:
# Delete temporary files (via clean) and also delete dist files
realclean purge :: realclean_subdirs
- $(RM_F) \
$(FIRST_MAKEFILE) $(MAKEFILE_OLD)
- $(RM_RF) \
$(DISTVNAME)
# --- MakeMaker metafile section:
metafile : create_distdir
$(NOECHO) $(ECHO) Generating META.yml
$(NOECHO) $(ECHO) --- > META_new.yml
$(NOECHO) $(ECHO) "abstract: unknown" >> META_new.yml
$(NOECHO) $(ECHO) author: >> META_new.yml
$(NOECHO) $(ECHO) " - unknown" >> META_new.yml
$(NOECHO) $(ECHO) build_requires: >> META_new.yml
$(NOECHO) $(ECHO) " ExtUtils::MakeMaker: '0'" >> META_new.yml
$(NOECHO) $(ECHO) configure_requires: >> META_new.yml
$(NOECHO) $(ECHO) " ExtUtils::MakeMaker: '0'" >> META_new.yml
$(NOECHO) $(ECHO) "dynamic_config: 1" >> META_new.yml
$(NOECHO) $(ECHO) "generated_by: 'ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010'" >> META_new.yml
$(NOECHO) $(ECHO) "license: unknown" >> META_new.yml
$(NOECHO) $(ECHO) meta-spec: >> META_new.yml
$(NOECHO) $(ECHO) " url: http://module-build.sourceforge.net/META-spec-v1.4.html" >> META_new.yml
$(NOECHO) $(ECHO) " version: '1.4'" >> META_new.yml
$(NOECHO) $(ECHO) "name: Graph-Easy" >> META_new.yml
$(NOECHO) $(ECHO) no_index: >> META_new.yml
$(NOECHO) $(ECHO) " directory:" >> META_new.yml
$(NOECHO) $(ECHO) " - t" >> META_new.yml
$(NOECHO) $(ECHO) " - inc" >> META_new.yml
$(NOECHO) $(ECHO) requires: >> META_new.yml
$(NOECHO) $(ECHO) " Scalar::Util: '1.13'" >> META_new.yml
$(NOECHO) $(ECHO) " Test::More: '0.62'" >> META_new.yml
$(NOECHO) $(ECHO) " strict: '0'" >> META_new.yml
$(NOECHO) $(ECHO) " vars: '0'" >> META_new.yml
$(NOECHO) $(ECHO) " warnings: '0'" >> META_new.yml
$(NOECHO) $(ECHO) "version: '0.76'" >> META_new.yml
$(NOECHO) $(ECHO) "x_serialization_backend: 'CPAN::Meta::YAML version 0.018'" >> META_new.yml
-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
$(NOECHO) $(ECHO) Generating META.json
$(NOECHO) $(ECHO) { > META_new.json
$(NOECHO) $(ECHO) " \"abstract\" : \"unknown\"," >> META_new.json
$(NOECHO) $(ECHO) " \"author\" : [" >> META_new.json
$(NOECHO) $(ECHO) " \"unknown\"" >> META_new.json
$(NOECHO) $(ECHO) " ]," >> META_new.json
$(NOECHO) $(ECHO) " \"dynamic_config\" : 1," >> META_new.json
$(NOECHO) $(ECHO) " \"generated_by\" : \"ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010\"," >> META_new.json
$(NOECHO) $(ECHO) " \"license\" : [" >> META_new.json
$(NOECHO) $(ECHO) " \"unknown\"" >> META_new.json
$(NOECHO) $(ECHO) " ]," >> META_new.json
$(NOECHO) $(ECHO) " \"meta-spec\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"url\" : \"http://search.cpan.org/perldoc?CPAN::Meta::Spec\"," >> META_new.json
$(NOECHO) $(ECHO) " \"version\" : 2" >> META_new.json
$(NOECHO) $(ECHO) " }," >> META_new.json
$(NOECHO) $(ECHO) " \"name\" : \"Graph-Easy\"," >> META_new.json
$(NOECHO) $(ECHO) " \"no_index\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"directory\" : [" >> META_new.json
$(NOECHO) $(ECHO) " \"t\"," >> META_new.json
$(NOECHO) $(ECHO) " \"inc\"" >> META_new.json
$(NOECHO) $(ECHO) " ]" >> META_new.json
$(NOECHO) $(ECHO) " }," >> META_new.json
$(NOECHO) $(ECHO) " \"prereqs\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"build\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"requires\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"ExtUtils::MakeMaker\" : \"0\"" >> META_new.json
$(NOECHO) $(ECHO) " }" >> META_new.json
$(NOECHO) $(ECHO) " }," >> META_new.json
$(NOECHO) $(ECHO) " \"configure\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"requires\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"ExtUtils::MakeMaker\" : \"0\"" >> META_new.json
$(NOECHO) $(ECHO) " }" >> META_new.json
$(NOECHO) $(ECHO) " }," >> META_new.json
$(NOECHO) $(ECHO) " \"runtime\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"requires\" : {" >> META_new.json
$(NOECHO) $(ECHO) " \"Scalar::Util\" : \"1.13\"," >> META_new.json
$(NOECHO) $(ECHO) " \"Test::More\" : \"0.62\"," >> META_new.json
$(NOECHO) $(ECHO) " \"strict\" : \"0\"," >> META_new.json
$(NOECHO) $(ECHO) " \"vars\" : \"0\"," >> META_new.json
$(NOECHO) $(ECHO) " \"warnings\" : \"0\"" >> META_new.json
$(NOECHO) $(ECHO) " }" >> META_new.json
$(NOECHO) $(ECHO) " }" >> META_new.json
$(NOECHO) $(ECHO) " }," >> META_new.json
$(NOECHO) $(ECHO) " \"release_status\" : \"stable\"," >> META_new.json
$(NOECHO) $(ECHO) " \"version\" : \"0.76\"," >> META_new.json
$(NOECHO) $(ECHO) " \"x_serialization_backend\" : \"JSON::PP version 4.02\"" >> META_new.json
$(NOECHO) $(ECHO) } >> META_new.json
-$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
# --- MakeMaker signature section:
signature :
cpansign -s
# --- MakeMaker dist_basics section:
distclean :: realclean distcheck
$(NOECHO) $(NOOP)
distcheck :
$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
skipcheck :
$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
manifest :
$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
veryclean : realclean
$(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old
# --- MakeMaker dist_core section:
dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
$(NOECHO) $(ABSPERLRUN) -l -e "print 'Warning: Makefile possibly out of date with $(VERSION_FROM)'\
if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)';" --
tardist : $(DISTVNAME).tar$(SUFFIX)
$(NOECHO) $(NOOP)
uutardist : $(DISTVNAME).tar$(SUFFIX)
uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu'
$(DISTVNAME).tar$(SUFFIX) : distdir
$(PREOP)
$(TO_UNIX)
$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(COMPRESS) $(DISTVNAME).tar
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)'
$(POSTOP)
zipdist : $(DISTVNAME).zip
$(NOECHO) $(NOOP)
$(DISTVNAME).zip : distdir
$(PREOP)
$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip'
$(POSTOP)
shdist : distdir
$(PREOP)
$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
$(RM_RF) $(DISTVNAME)
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar'
$(POSTOP)
# --- MakeMaker distdir section:
create_distdir :
$(RM_RF) $(DISTVNAME)
$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
distdir : create_distdir distmeta
$(NOECHO) $(NOOP)
# --- MakeMaker dist_test section:
disttest : distdir
cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
# --- MakeMaker dist_ci section:
ci :
$(ABSPERLRUN) -MExtUtils::Manifest=maniread -e "@all = sort keys %{ maniread() };\
print(qq{Executing $(CI) @all\n});\
system(qq{$(CI) @all}) == 0 or die $$!;\
print(qq{Executing $(RCS_LABEL) ...\n});\
system(qq{$(RCS_LABEL) @all}) == 0 or die $$!;" --
# --- MakeMaker distmeta section:
distmeta : create_distdir metafile
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e "exit unless -e q{META.yml};\
eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }\
or die \"Could not add META.yml to MANIFEST: $${'^@'}\"" --
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e "exit unless -f q{META.json};\
eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }\
or die \"Could not add META.json to MANIFEST: $${'^@'}\"" --
# --- MakeMaker distsignature section:
distsignature : distmeta
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e "eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }\
or die \"Could not add SIGNATURE to MANIFEST: $${'^@'}\"" --
$(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
cd $(DISTVNAME) && cpansign -s
# --- MakeMaker install section:
install :: pure_install doc_install
$(NOECHO) $(NOOP)
install_perl :: pure_perl_install doc_perl_install
$(NOECHO) $(NOOP)
install_site :: pure_site_install doc_site_install
$(NOECHO) $(NOOP)
install_vendor :: pure_vendor_install doc_vendor_install
$(NOECHO) $(NOOP)
pure_install :: pure_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
doc_install :: doc_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
pure__install : pure_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
doc__install : doc_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
pure_perl_install :: all
$(NOECHO) $(MOD_INSTALL) \
read "$(PERL_ARCHLIB)\auto\$(FULLEXT)\.packlist" \
write "$(DESTINSTALLARCHLIB)\auto\$(FULLEXT)\.packlist" \
"$(INST_LIB)" "$(DESTINSTALLPRIVLIB)" \
"$(INST_ARCHLIB)" "$(DESTINSTALLARCHLIB)" \
"$(INST_BIN)" "$(DESTINSTALLBIN)" \
"$(INST_SCRIPT)" "$(DESTINSTALLSCRIPT)" \
"$(INST_MAN1DIR)" "$(DESTINSTALLMAN1DIR)" \
"$(INST_MAN3DIR)" "$(DESTINSTALLMAN3DIR)"
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
"$(SITEARCHEXP)\auto\$(FULLEXT)"
pure_site_install :: all
$(NOECHO) $(MOD_INSTALL) \
read "$(SITEARCHEXP)\auto\$(FULLEXT)\.packlist" \
write "$(DESTINSTALLSITEARCH)\auto\$(FULLEXT)\.packlist" \
"$(INST_LIB)" "$(DESTINSTALLSITELIB)" \
"$(INST_ARCHLIB)" "$(DESTINSTALLSITEARCH)" \
"$(INST_BIN)" "$(DESTINSTALLSITEBIN)" \
"$(INST_SCRIPT)" "$(DESTINSTALLSITESCRIPT)" \
"$(INST_MAN1DIR)" "$(DESTINSTALLSITEMAN1DIR)" \
"$(INST_MAN3DIR)" "$(DESTINSTALLSITEMAN3DIR)"
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
"$(PERL_ARCHLIB)\auto\$(FULLEXT)"
pure_vendor_install :: all
$(NOECHO) $(MOD_INSTALL) \
read "$(VENDORARCHEXP)\auto\$(FULLEXT)\.packlist" \
write "$(DESTINSTALLVENDORARCH)\auto\$(FULLEXT)\.packlist" \
"$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \
"$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \
"$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \
"$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \
"$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \
"$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)"
doc_perl_install :: all
$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
-$(NOECHO) $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLPRIVLIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> "$(DESTINSTALLARCHLIB)\perllocal.pod"
doc_site_install :: all
$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
-$(NOECHO) $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> "$(DESTINSTALLARCHLIB)\perllocal.pod"
doc_vendor_install :: all
$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
-$(NOECHO) $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLVENDORLIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> "$(DESTINSTALLARCHLIB)\perllocal.pod"
uninstall :: uninstall_from_$(INSTALLDIRS)dirs
$(NOECHO) $(NOOP)
uninstall_from_perldirs ::
$(NOECHO) $(UNINSTALL) "$(PERL_ARCHLIB)\auto\$(FULLEXT)\.packlist"
uninstall_from_sitedirs ::
$(NOECHO) $(UNINSTALL) "$(SITEARCHEXP)\auto\$(FULLEXT)\.packlist"
uninstall_from_vendordirs ::
$(NOECHO) $(UNINSTALL) "$(VENDORARCHEXP)\auto\$(FULLEXT)\.packlist"
# --- MakeMaker force section:
# Phony target to force checking subdirectories.
FORCE :
$(NOECHO) $(NOOP)
# --- MakeMaker perldepend section:
# --- MakeMaker makefile section:
# We take a very conservative approach here, but it's worth it.
# We move Makefile to Makefile.old here to avoid gnu make looping.
$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
-$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
$(PERLRUN) Makefile.PL
$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
$(FALSE)
# --- MakeMaker staticmake section:
# --- MakeMaker makeaperl section ---
MAP_TARGET = perl
FULLPERL = "C:\Strawberry\perl\bin\perl.exe"
MAP_PERLINC = "-Iblib\arch" "-Iblib\lib" "-IC:\STRAWB~1\perl\lib" "-IC:\STRAWB~1\perl\lib"
$(MAP_TARGET) :: $(MAKE_APERL_FILE)
$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
$(MAKE_APERL_FILE) : static $(FIRST_MAKEFILE) pm_to_blib
$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
$(NOECHO) $(PERLRUNINST) \
Makefile.PL DIR="" \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
# --- MakeMaker test section:
TEST_VERBOSE=0
TEST_TYPE=test_$(LINKTYPE)
TEST_FILE = test.pl
TEST_FILES = t/*.t
TESTDB_SW = -d
testdb :: testdb_$(LINKTYPE)
$(NOECHO) $(NOOP)
test :: $(TEST_TYPE)
$(NOECHO) $(NOOP)
# Occasionally we may face this degenerate target:
test_ : test_dynamic
$(NOECHO) $(NOOP)
subdirs-test_dynamic :: dynamic pure_all
test_dynamic :: subdirs-test_dynamic
$(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
testdb_dynamic :: dynamic pure_all
$(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
subdirs-test_static :: static pure_all
test_static :: subdirs-test_static
$(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
testdb_static :: static pure_all
$(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
# --- MakeMaker ppd section:
# Creates a PPD (Perl Package Description) for a binary distribution.
ppd :
$(NOECHO) $(ECHO) "<SOFTPKG NAME=\"Graph-Easy\" VERSION=\"0.76\">" > Graph-Easy.ppd
$(NOECHO) $(ECHO) " <ABSTRACT></ABSTRACT>" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <AUTHOR></AUTHOR>" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <IMPLEMENTATION>" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <REQUIRE NAME=\"Scalar::Util\" VERSION=\"1.13\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <REQUIRE NAME=\"Test::More\" VERSION=\"0.62\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <REQUIRE NAME=\"strict::\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <REQUIRE NAME=\"vars::\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <REQUIRE NAME=\"warnings::\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <ARCHITECTURE NAME=\"MSWin32-x64-multi-thread-5.30\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " <CODEBASE HREF=\"\" />" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) " </IMPLEMENTATION>" >> Graph-Easy.ppd
$(NOECHO) $(ECHO) ^</SOFTPKG^> >> Graph-Easy.ppd
# --- MakeMaker pm_to_blib section:
pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM)
$(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e "pm_to_blib({@ARGV}, '$(INST_LIB)\auto', q[$(PM_FILTER)], '$(PERM_DIR)')" -- \
lib/Graph/Easy.pm blib\lib\Graph\Easy.pm \
lib/Graph/Easy/As_ascii.pm blib\lib\Graph\Easy\As_ascii.pm \
lib/Graph/Easy/As_graphml.pm blib\lib\Graph\Easy\As_graphml.pm \
lib/Graph/Easy/As_graphviz.pm blib\lib\Graph\Easy\As_graphviz.pm \
lib/Graph/Easy/As_txt.pm blib\lib\Graph\Easy\As_txt.pm \
lib/Graph/Easy/As_vcg.pm blib\lib\Graph\Easy\As_vcg.pm \
lib/Graph/Easy/Attributes.pm blib\lib\Graph\Easy\Attributes.pm \
lib/Graph/Easy/Base.pm blib\lib\Graph\Easy\Base.pm \
lib/Graph/Easy/Edge.pm blib\lib\Graph\Easy\Edge.pm \
lib/Graph/Easy/Edge/Cell.pm blib\lib\Graph\Easy\Edge\Cell.pm \
lib/Graph/Easy/Group.pm blib\lib\Graph\Easy\Group.pm \
lib/Graph/Easy/Group/Anon.pm blib\lib\Graph\Easy\Group\Anon.pm \
lib/Graph/Easy/Group/Cell.pm blib\lib\Graph\Easy\Group\Cell.pm \
lib/Graph/Easy/Layout.pm blib\lib\Graph\Easy\Layout.pm \
lib/Graph/Easy/Layout/Chain.pm blib\lib\Graph\Easy\Layout\Chain.pm \
lib/Graph/Easy/Layout/Force.pm blib\lib\Graph\Easy\Layout\Force.pm \
lib/Graph/Easy/Layout/Grid.pm blib\lib\Graph\Easy\Layout\Grid.pm \
lib/Graph/Easy/Layout/Path.pm blib\lib\Graph\Easy\Layout\Path.pm \
lib/Graph/Easy/Layout/Repair.pm blib\lib\Graph\Easy\Layout\Repair.pm \
lib/Graph/Easy/Layout/Scout.pm blib\lib\Graph\Easy\Layout\Scout.pm
$(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e "pm_to_blib({@ARGV}, '$(INST_LIB)\auto', q[$(PM_FILTER)], '$(PERM_DIR)')" -- \
lib/Graph/Easy/Node.pm blib\lib\Graph\Easy\Node.pm \
lib/Graph/Easy/Node/Anon.pm blib\lib\Graph\Easy\Node\Anon.pm \
lib/Graph/Easy/Node/Cell.pm blib\lib\Graph\Easy\Node\Cell.pm \
lib/Graph/Easy/Node/Empty.pm blib\lib\Graph\Easy\Node\Empty.pm \
lib/Graph/Easy/Parser.pm blib\lib\Graph\Easy\Parser.pm \
lib/Graph/Easy/Parser/Graphviz.pm blib\lib\Graph\Easy\Parser\Graphviz.pm \
lib/Graph/Easy/Parser/VCG.pm blib\lib\Graph\Easy\Parser\VCG.pm \
lib/Graph/Easy/Util.pm blib\lib\Graph\Easy\Util.pm
$(NOECHO) $(TOUCH) pm_to_blib
# --- MakeMaker selfdocument section:
# here so even if top_targets is overridden, these will still be defined
# gmake will silently still work if any are .PHONY-ed but nmake won't
static ::
$(NOECHO) $(NOOP)
dynamic ::
$(NOECHO) $(NOOP)
config ::
$(NOECHO) $(NOOP)
# --- MakeMaker postamble section:
# End.

21
perl/lib/Graph-Easy-0.76/Makefile.PL Normal file
View File

@@ -0,0 +1,21 @@
# Note: this file was auto-generated by Module::Build::Compat version 0.4218
require 5.008002;
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'Graph::Easy',
'VERSION_FROM' => 'lib/Graph/Easy.pm',
'PREREQ_PM' => {
'Scalar::Util' => '1.13',
'Test::More' => '0.62',
'strict' => 0,
'vars' => 0,
'warnings' => 0
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [
'bin/graph-easy'
],
'PL_FILES' => {}
)
;

75
perl/lib/Graph-Easy-0.76/README Normal file
View File

@@ -0,0 +1,75 @@
Graph-Easy
==========
This module lets you create graphs (nodes/vertices connected by edges/arcs,
not pie charts!) and then lay them out on a flat surface.
Once laid out, the graph can be converted into various output formats like
ASCII art, HTML or SVG. You can also output the graph in graphviz format
and let dot/neato/circo etc. do the layout for you.
Graphs can be either generated by Perl code, parsed from a simple text format
that is human readable and maintainable, or parsed from Graphviz code.
For instance this input:
[ Bonn ] -> [ Berlin ]
[ Berlin ] -> [ Frankfurt ] { border: 1px dotted black; }
[ Frankfurt ] -> [ Dresden ]
[ Berlin ] ..> [ Potsdam ]
[ Potsdam ] => [ Cottbus ]
would be rendered in ASCII as:
+------+ +--------+ ............. +---------+
| Bonn | --> | Berlin | --> : Frankfurt : --> | Dresden |
+------+ +--------+ ............. +---------+
:
:
v
+---------+ +---------+
| Potsdam | ==> | Cottbus |
+---------+ +---------+
The HTML or SVG output would look similar except be more pretty :o)
Manual
======
The manual is contained in the extra package Graph::Easy::Manual, which
also contains a Pod2HTML converter, that can handle embedded graphs
in POD files.
You can also view the manual online at:
http://bloodgate.com/perl/graph/manual/
Many more examples and documentation, especially on integrating this into
a Mediawiki installation, can be found at:
http://bloodgate.com/perl/graph/
Have fun!
SVG Output
==========
You also might want to install Graph::Easy::As_svg from CPAN, it provides
you with the ability to generate SVG (Scalable Vector Graphics) files.
Installation
============
See INSTALL on how to install this module.
AUTHOR
======
Copyright (C) 2004 - 2008 by Tels http://bloodgate.com/
This library is free software; you can redistribute it and/or modify
it under the same terms of the GPL version 2.
This module was formerly known as Graph-Simple, but has been renamed
because it can also easily create non-simple graphs.

227
perl/lib/Graph-Easy-0.76/TODO Normal file
View File

@@ -0,0 +1,227 @@
Graph-Easy
==========
See Graph::Easy under LIMITATIONS for some hot topics. In addition:
Important short-term TODO:
* sort_sub is no longer used in Heap, but the Layouter uses it (find out why)
* add for edges:
+ weight,
+ taillabel, taillink, tailtitle, headlabel, headlink, headtitle
(or should these be startlabel, endlabel etc.?)
+ a method to set the direction to bidirectional/undirected
* graphviz parsing roundtrip:
+ anon nodes lose their " " label
+ border-width is wrongly dropped
+ t/in/dot/9_edge_styles.dot is wrong
+ nodes with HTML-like labels lose their outer shape (the label itself
can have a border on the TABLE, as well as the node outside
as well as the individual TD elements)
* Combining table cells goes wrong if there is a "hole" in a row
of cells. We need to gather them with their coordinates and only
combine cells that are next to each other.
* setting "size" as class attribute doesn't work
* setting "offset: -2,0;" causes problems for multi-row nodes because
the offset is taken into effect before growing the node
* [ a ] { label: a; } - remove the superflous label upon parsing
* VCG/GDL
+ debug, finish the attribute remapping and add more test cases
+ implement support for \fn \fb \fI \fu \fB (bold underline etc.)
+ implement support for \f03 (colors)
+ implement support for \f- (hor line)
+ implement full color-remapping support (in both directions)
+ support subgraphs
+ support regions
+ support "nearedges:no"
+ generally handle all attribute names without "_", too
+ add support for "anchor"
+ GDL has portsharing only as attributes for the top graph, while
in Graph::Easy this attribute can be set for each edge
* layouter:
+ head/tail label/title and link are currently ignored
+ implement autosplit and autojoin for edges
+ don't build chains across groups
+ route multiple edges to/from a node in the proper order (shortest first)
+ edges without a specific start/end port should not block ports that
are reserved for edges with a start/end port number
+ placing a node with an origin/offset inside another node results in
endless loops as this condition is not checked and the placement
of the grandparent node will thus always fail
+ last-resort placing of node should first try to place it more near
to where the edge(s) are connected
+ allow end/start without specifying a side: "[ A ]--> { end: 0; } [ B ]"
+ t/in/5_joint.txt - the rendering order is C,A,B, so that the edge
from A to Z comes before B to Z. And since the layouter "knows" it
should not block the last port on B, it makes a bend. In this case, tho,
it could just go along B, because the edges join each other anyway.
+ handle the special case where a node relative to another belongs to
a different group than the parent/child
Recursive layouter:
+ an empty group should consist of one cell (with the label and border)
+ lay out all groups first, then interlink them together
* as_graphviz():
+ links to/from empty groups fail
+ attributes should be always checked against the default attribute and
output if necessary, to make setting attributes in classes work -
currently doing edge { color: blue; } will be ignored
+ finish HTML-like labels (esp. with borders)
These things seem to be actually not possible in Graphviz:
+ border-styles: wave, dot-dot-dash and dot-dash
+ edge-styles: wave, dot-dot-dash and dot-dash
+ text-styles: underline, overline, strike-through, italic and bold
* Parser/Graphviz:
+ see also the section CAVEATS in Graph::Easy::Parser::Graphviz
+ style=filled should result in color => fillcolor, not color => fontcolor
+ parse input in Latin1 charset
+ parse "A|{ B|C }" (record shape with hor/ver nesting)
+ nodes with shape record, but an edge going from the aggregate node have
the edges rendered in dot starting/ending *somewhere* on the node with the
record shape. We always (re-)connect these edges to the first part of the
autosplit node. Maybe we should balance them to use parts with as little
edges as possible. (The entire feature is quite bogus, since it is not
clear from the resulting image where the edge really starts/ends, at the
aggregate node or at the specific part where the arrow/line ends up
pointing to/from...:-/
+ attributes unknown to dot, but valid under Graph::Easy (like "labelpos")
cause an error instead of a warning
+ autosplit nodes (record) lose their attributes, these need to
be carried over from the temp. node.
+ parse nested tables
* as_ascii:
+ better support for different shapes (circle, box, polygon etc)
+ implement pod-formatted labels (*bold*, /italic/,
_underline_, -l-i-n-e-t-h-r-o-u-g-h-, ~overline~, "code")
+ rendering of "(group)" is empty (need a recursive layouter for that,
since the current layouter doesn't add any group cells if a group doesn't
have any node or edge at all)
* as_html:
+ fill on edges
+ v-- and --^ edges (mis-aligned arrows)
(complete edge-arrow alignment in HTML)
+ shift arrows on hor edge end/starts (non-short) left/right, too
+ output of node-clusters is slightly wrong
+ there is no space between two nodes placed next (with filler
cell) to each other. Make filler cells output a &nbsp;?
+ bidir. self-loops are rendered with only one arrow: [A] <--> [A]
+ define missing HTML edge pieces: CROSS sections with end/start points
+ define JOINTs with start/end pieces (6 for each joints, making 24 types)
+ implement HTML nodes as triangles, house, etc. using slanted edges
* fix nesting with pod-formatted labels
* edges between groups (ala "( 1 [A ]) -> ( 2 [B] )") or between a node
and a group are missing in HTML, ASCII, BOXART and SVG.
* It would be good if we could remove Node::Empty (it blocks a cell
just to draw the right/bottom border pieces)
(we might put these "invisible" nodes into a different "cells" field,
which will be rendered, but not queried for path finding etc)
Output:
* selfloop edges should counter the general flow:
Until done
+------------+
v |
+-------+ +----------------+ +-----+
| Start | --> | Main | --> | End |
+-------+ +----------------+ +-----+
versus (loop still going left):
Until done
+------------+
v |
+-----+ +----------------+ +-------+
| End | <-- | Main | <-- | Start |
+-----+ +----------------+ +-------+
* support two different arrow shapes on bidirectional edges
* as_txt():
+ output of node clusters and node chains is not optimal
+ links between groups are missing
* as_ascii() and others: grow cells around point-shaped nodes to intrude:
...........................
: : | : : :
: : | : : :
: : v : : :
...........................
: : : : :
:-----> : * : <---- : :
: : : : :
...........................
(at least the edge pieces could omit their left/right spacer in ASCII)
* as_boxart has some incorrect corner pieces:
echo "[A|B|C||D]" | perl examples/as_boxart
┌───┐───┐───┐
│ A │ B │ C │
└───┘───┘───┘
│ D │
└───┘
echo "[A| |C||D| |E]" |perl examples/as_boxart
┌───┐ ┌───┐
│ A │ │ C │
└───┘ └───┘
│ │ │ │
│ D │ │ E │
└───┘ └───┘
Layout:
* allow user to specify max graph width (in cells) to avoid overly wide graphs
* auto-grow nodes to be multicelled depending on the dimensions of their label
("main page" gets 2x1, while "a \nb \nc \nd \ne \n" gets 1x2 cells)
This currently causes problems and weird layouts.
* Use the seed to generate randomized layouts
Rendering/Layout:
* allow "align: center, middle|top|bottom" for vertical alignment of labels.
* add padding attributes (especially useful for HTML/SVG output)
* add "shape" for groups:
+ rect
+ compact (the default, what it is now)
+ none (no background, no border, no label)
* add attribute "opacity" to set alpha channel on entire objects more easily
* add attribute "shrink" (yes, no) to nodes to make them as compact as poss.
General:
* allow multiple subclasses ala CSS:
node.red { color: red; }
node.green { color: green; }
[ Red ] { class: red green; } -> [ Green ] { class: green red; }
* Implement more class selectors:
+ #id (object with ID id)
* implement pseudo-class "step" for animations (see POD)
* add some possibility to have different fonts, sizes and colors inside one
label ala (when labelstyle=pod):
FG<red|red text> BG<red|red background> FS<2em|big text>
Optimizing:
* put framebuffer related routines into own package (Graph::Easy::As_ascii)
to avoid the dilemma that we need them from both Node and Graph.
Likewise, some routines used by objects (e.g. graph, node etc) should
be in a super-package and inherited)
* improve the after-layout optimizer
* less memory: store border and edge styles as ints instead of "solid" etc

96
perl/lib/Graph-Easy-0.76/bench/bench.pl Normal file
View File

@@ -0,0 +1,96 @@
#!/usr/bin/perl -w
use Benchmark;
use Graph::Easy;
use Time::HiRes qw/time/;
use strict;
use Devel::Size qw/total_size/;
print "# Graph::Easy v", $Graph::Easy::VERSION,"\n";
print "Creating graph...\n";
my ($g,$n,$last);
time_it ( \&create, shift);
print "Creating txt...\n";
time_it ( \&as_txt );
# dump the text for later
#print STDERR $g->as_txt(); exit;
#print STDERR $g->as_graphviz(); exit;
# $g->timeout(20) if $g->can('timeout');
print $g->as_ascii() if $g->nodes() < 40;
# for profile with -d:DProf
#for (0..5) { $g->layout(); } exit;
print "\n";
exit if shift;
print "Benchmarking...\n";
$n = $g->node('1');
timethese (-5,
{
'node cnt' => sub { scalar $g->nodes(); },
'edge cnt' => sub { scalar $g->edges(); },
'nodes' => sub { my @O = $g->nodes(); },
'edges' => sub { my @O = $g->edges(); },
"conn's" => sub { $n->connections(); },
"succ's" => sub { scalar $n->successors(); },
"succ' cnt" => sub { my @O = $n->successors(); },
"edges_to" => sub { my @O = $n->edges_to($last) },
# "layout" => sub { $g->layout(); },
# "as_txt" => sub { $g->as_txt(); },
} );
sub time_it
{
my $time = time;
my $r = shift;
&$r(@_);
printf ("Took %0.4fs\n", time - $time);
}
sub as_txt
{
my $t = $g->as_txt();
}
sub create
{
my $cnt = abs(shift || 1000);
$g = Graph::Easy->new();
$n = Graph::Easy::Node->new('0');
$last = Graph::Easy::Node->new('1');
for (2..$cnt)
{
my $node = Graph::Easy::Node->new($_);
$g->add_edge($last, $node);
my $n2 = Graph::Easy::Node->new($_.'A');
$g->add_edge($last, $n2);
my $n3 = Graph::Easy::Node->new($_.'B');
$g->add_edge($last, $n3);
$last = $node;
}
# prior to 0.25, the two calls to nodes() and edges() will take O(N) time, further
# slowing down this routine by about 10-20%.
print "Have now ", scalar $g->nodes(), " nodes and ", scalar $g->edges()," edges.\n";
print "Graph objects takes ", total_size($g), " bytes.\n";
}

124
perl/lib/Graph-Easy-0.76/bench/serie.pl Normal file
View File

@@ -0,0 +1,124 @@
#!/usr/bin/perl -w
use Benchmark;
use Graph::Easy;
use Time::HiRes qw/time/;
use strict;
use Devel::Size qw/total_size/;
print "# Graph::Easy v", $Graph::Easy::VERSION,"\n";
my @results;
my ($n,$last,$g, $size);
my @counts = ( qw/5 10 50 100 200 500 1000/ );
for my $count (@counts)
{
print "Creating graph with ", $count * 3, " nodes and edges...\n";
my $rc = [ ];
push @$rc, time_it ( \&create, $count);
$size = total_size($g);
print "Graph objects takes $size bytes.\n";
print "Creating txt...\n";
print $g->as_ascii() if $count == 5;
if ($Graph::Easy::VERSION < 0.25 && ($count > 500))
{
print "Skipping as_foo() tests.\n";
push @$rc, 0, 0;
}
else
{
push @$rc,
time_it ( \&as_txt ),
time_it ( \&as_ascii);
}
push @$rc, $size;
push @results, $rc;
}
print "Results\n";
for my $r (@results)
{
print join (" ", @$r),"\n";
}
print " <tr>\n <th>Graph::Easy v$Graph::Easy::VERSION</th>\n <th>"
. join ("</th>\n <th>", @counts) . "</th>\n </tr>\n";
my $i = 0;
for my $t ( qw/Creation as_txt as_ascii Memory/ )
{
print " <tr>\n <td>$t</td>\n";
for my $r (@results)
{
print " <td>$r->[$i]</td>\n";
}
print " </tr>\n";
$i++;
}
#print STDERR $g->as_graphviz();
1;
#############################################################################
sub time_it
{
my $time = time;
my $r = shift;
&$r(@_);
my $took = sprintf ("%0.4f", time - $time);
print "Took ${took}s\n";
$took;
}
sub as_txt
{
my $t = $g->as_txt();
}
sub as_ascii
{
my $t = $g->as_ascii();
}
sub create
{
my $cnt = abs(shift || 1000);
$g = Graph::Easy->new();
$n = Graph::Easy::Node->new('0');
$last = Graph::Easy::Node->new('1');
for (2..$cnt+1)
{
my $node = Graph::Easy::Node->new($_);
$g->add_edge($last, $node);
my $n2 = Graph::Easy::Node->new($_.'A');
$g->add_edge($last, $n2);
my $n3 = Graph::Easy::Node->new($_.'B');
$g->add_edge($last, $n3);
$last = $node;
}
# prior to 0.25, the two calls to nodes() and edges() will take O(N) time, further
# slowing down this routine by about 10-20%.
print "Have now ", scalar $g->nodes(), " nodes and ", scalar $g->edges()," edges.\n";
$g->{timeout} = 120;
}

137
perl/lib/Graph-Easy-0.76/bench/stress.pl Normal file
View File

@@ -0,0 +1,137 @@
#!/usr/bin/perl -w
BEGIN
{
use lib 'lib';
$|++;
}
use Scalar::Util qw/weaken/;
use Time::HiRes qw/time/;
use Data::Dumper;
use Graph::Easy;
my $N1 = shift || 5000;
my $N2 = shift || 40000;
my $STEP = shift || 2;
# results
my $RC = [];
print "Using Graph::Easy v$Graph::Easy::VERSION\n";
for (my $N = $N1; $N < $N2; $N *= $STEP)
{
my @R = ($N);
my $start = time();
print scalar localtime(), " start\n";
normal($N);
print scalar localtime(), " done, took ", sprintf("%.2f", time() - $start)," seconds\n";
push @R, sprintf("%.2f",time() - $start);
$start = time();
print scalar localtime(), " start\n";
my $graph = graph($N); # return the graph to show that creation sep.
print scalar localtime(), " done creation, took ", sprintf("%.2f", time() - $start)," seconds\n";
push @R, sprintf("%.2f",time() - $start);
$start = time();
$graph = undef;
print scalar localtime(), " done destroy, took ", sprintf("%.2f", time() - $start)," seconds\n";
push @R, sprintf("%.2f",time() - $start);
$start = time();
push @$RC, [ @R ];
}
print "\n";
print "\n", join("\t\t", 'N', 'Normal', 'Graph-Easy'), "\tGraph-Easy\n";
print join("\t\t", '', '', 'Create','Destroy'), "\n";
print '-' x 70,"\n";
# print results
for my $R (@$RC)
{
print join("\t\t", @$R), "\n";
}
sub graph
{
my $N = shift;
my $graph = Graph::Easy->new();
# create N objects, and "link" them together
for my $i (1..$N)
{
my $b = $i; $b++;
$graph->add_edge($i,$b);
}
print Dumper($graph),"\n" if $N < 10;
$graph;
}
sub normal
{
my $N = shift;
my $container = {};
my $old_object;
# create N objects, and "link" them together
for my $i (1..$N)
{
my $o = new_object($i);
$container->{nodes}->{$i} = $o;
$o->{graph} = $container;
weaken($o->{graph});
if ($old_object)
{
my $link = new_link($old_object, $o, $i);
$container->{edges}->{$i} = $link;
$link->{graph} = $container;
{
no warnings;
weaken($link->{graph});
weaken($link->{to}->{graph});
weaken($link->{from}->{graph});
}
}
$old_object = $o;
}
print Dumper($container),"\n" if $N < 10;
}
sub new_object
{
my $id = shift;
my $o = bless { id => $id, att => {}, }, 'main';
$o;
}
sub new_link
{
my ($a,$b,$id) = @_;
my $link = bless { id => $id, from => $a, to => $b, att => {} }, 'main';
$a->{edges}->{$id} = $link;
$b->{edges}->{$id} = $link;
$link;
}

18
perl/lib/Graph-Easy-0.76/bench/test.dot Normal file
View File

@@ -0,0 +1,18 @@
digraph GRAPH_0 {
// Generated by Graph::Easy 0.38 at Sat Dec 31 16:13:04 2005
edge [ arrowhead=open ];
graph [ rankdir=LR ];
node [
fontsize=11,
fillcolor=white,
style=filled,
shape=box ];
Berlin [ URL="/wiki/index.php/Berlin" ]
Bonn [ URL="/wiki/index.php/Bonn" ]
Bonn -> Berlin
}

2
perl/lib/Graph-Easy-0.76/bench/test.txt Normal file
View File

@@ -0,0 +1,2 @@
graph { autolink: name; }
[ Bonn ] -> [ Berlin ]

0
perl/lib/Graph-Easy-0.76/blib/arch/.exists Normal file
View File

0
perl/lib/Graph-Easy-0.76/blib/arch/auto/Graph/Easy/.exists Normal file
View File

0
perl/lib/Graph-Easy-0.76/blib/lib/Graph/.exists Normal file
View File

4203
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy.pm Normal file
View File

File diff suppressed because it is too large Load Diff

1428
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_ascii.pm Normal file
View File

File diff suppressed because it is too large Load Diff

396
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_graphml.pm Normal file
View File

@@ -0,0 +1,396 @@
#############################################################################
# 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/&/&amp;/g; # quote &
$txt =~ s/>/&gt;/g; # quote >
$txt =~ s/</&lt;/g; # quote <
$txt =~ s/"/&quot;/g; # quote "
$txt =~ s/'/&apos;/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

1249
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_graphviz.pm Normal file
View File

File diff suppressed because it is too large Load Diff

487
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_txt.pm Normal file
View File

@@ -0,0 +1,487 @@
#############################################################################
# Output an Graph::Easy object as textual description
#
package Graph::Easy::As_txt;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
sub _as_txt
{
my ($self) = @_;
# Convert the graph to a textual representation - does not need layout().
$self->_assign_ranks();
# generate the class attributes first
my $txt = '';
my $att = $self->{att};
for my $class (sort keys %$att)
{
my $out = $self->_remap_attributes(
$class, $att->{$class}, {}, 'noquote', 'encode' );
my $att = '';
for my $atr (sort keys %$out)
{
# border is handled special below
next if $atr =~ /^border/;
$att .= " $atr: $out->{$atr};\n";
}
# edges do not have a border
if ($class !~ /^edge/)
{
my $border = $self->border_attribute($class) || '';
# 'solid 1px #000000' =~ /^solid/;
# 'solid 1px #000000' =~ /^solid 1px #000000/;
$border = '' if $self->default_attribute($class,'border') =~ /^$border/;
$att .= " border: $border;\n" if $border ne '';
}
if ($att ne '')
{
# the following makes short, single definitions to fit on one line
if ($att !~ /\n.*\n/ && length($att) < 40)
{
$att =~ s/\n/ /; $att =~ s/^ / /;
}
else
{
$att = "\n$att";
}
$txt .= "$class {$att}\n";
}
}
$txt .= "\n" if $txt ne ''; # insert newline
my @nodes = $self->sorted_nodes('name','id');
my $count = 0;
# output nodes with attributes first, sorted by their name
foreach my $n (@nodes)
{
$n->{_p} = undef; # mark as not yet processed
my $att = $n->attributes_as_txt();
if ($att ne '')
{
$n->{_p} = 1; # mark as processed
$count++;
$txt .= $n->as_pure_txt() . $att . "\n";
}
}
$txt .= "\n" if $count > 0; # insert a newline
# output groups first, with their nodes
foreach my $gn (sort keys %{$self->{groups}})
{
my $group = $self->{groups}->{$gn};
$txt .= $group->as_txt(); # marks nodes as processed if nec.
$count++;
}
# XXX TODO:
# Output all nodes with rank=0 first, and also follow their successors
# What is left will then be done next, with rank=1 etc.
# This output order let's us output node chains in compact form as:
# [A]->[B]->[C]->[D]
# [B]->[E]
# instead of having:
# [A]->[B]
# [B]->[E]
# [B]->[C] etc
@nodes = $self->sorted_nodes('rank','name');
foreach my $n (@nodes)
{
my @out = $n->sorted_successors();
my $first = $n->as_pure_txt(); # [ A | B ]
if ( defined $n->{autosplit} || ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0)))
{
# single node without any connections (unless already output)
next if exists $n->{autosplit} && !defined $n->{autosplit};
$txt .= $first . "\n" unless defined $n->{_p};
}
$first = $n->_as_part_txt(); # [ A.0 ]
# 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 .= $first . $edge->as_txt() . $other->_as_part_txt() . "\n";
}
}
}
foreach my $n (@nodes)
{
delete $n->{_p}; # clean up
}
$txt;
}
#############################################################################
package Graph::Easy::Group;
use strict;
sub as_txt
{
my $self = shift;
my $n = '';
if (!$self->isa('Graph::Easy::Group::Anon'))
{
$n = $self->{name};
# quote special chars in name
$n =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
$n = ' ' . $n;
}
my $txt = "($n";
$n = $self->{nodes};
$txt .= (keys %$n > 0 ? "\n" : ' ');
for my $name ( sort keys %$n )
{
$n->{$name}->{_p} = 1; # mark as processed
$txt .= ' ' . $n->{$name}->as_pure_txt() . "\n";
}
$txt .= ")" . $self->attributes_as_txt() . "\n\n";
# insert all the edges of the group
#
$txt;
}
#############################################################################
package Graph::Easy::Node;
use strict;
sub attributes_as_txt
{
# return the attributes of this node as text description
my ($self, $remap) = @_;
# nodes that were autosplit
if (exists $self->{autosplit})
{
# other nodes are invisible in as_txt:
return '' unless defined $self->{autosplit};
# the first one might have had a label set
}
my $att = '';
my $class = $self->class();
my $g = $self->{graph};
# XXX TODO: remove atttributes that are simple the default attributes
my $attributes = $self->{att};
if (exists $self->{autosplit})
{
# for the first node in a row of autosplit nodes, we need to create
# the correct attributes, e.g. "silver|red|" instead of just silver:
my $basename = $self->{autosplit_basename};
$attributes = { };
my $parts = $self->{autosplit_parts};
# gather all possible attribute names, otherwise an attribute set
# on only one part (like via "color: |red;" would not show up:
my $names = {};
for my $child ($self, @$parts)
{
for my $k (sort keys %{$child->{att}})
{
$names->{$k} = undef;
}
}
for my $k (sort keys %$names)
{
next if $k eq 'basename';
my $val = $self->{att}->{$k};
$val = '' unless defined $val;
my $first = $val; my $not_equal = 0;
$val .= '|';
for my $child (@$parts)
{
# only consider our own autosplit parts (check should not be nec.)
# next if !exists $child->{autosplit_basename} ||
# $child->{autosplit_basename} ne $basename;
my $v = $child->{att}->{$k}; $v = '' if !defined $v;
$not_equal ++ if $v ne $first;
$val .= $v . '|';
}
# all parts equal, so do "red|red|red" => "red"
$val = $first if $not_equal == 0;
$val =~ s/\|+\z/\|/; # "silver|||" => "silver|"
$val =~ s/\|\z// if $val =~ /\|.*\|/; # "silver|" => "silver|"
# but "red|blue|" => "red|blue"
$attributes->{$k} = $val unless $val eq '|'; # skip '|'
}
$attributes->{basename} = $self->{att}->{basename} if defined $self->{att}->{basename};
}
my $new = $g->_remap_attributes( $self, $attributes, $remap, 'noquote', 'encode' );
# For nodes, we do not output their group attribute, since they simple appear
# at the right place in the txt:
delete $new->{group};
# for groups inside groups, insert their group attribute
$new->{group} = $self->{group}->{name}
if $self->isa('Graph::Easy::Group') && exists $self->{group};
if (defined $self->{origin})
{
$new->{origin} = $self->{origin}->{name};
$new->{offset} = join(',', $self->offset());
}
# shorten output for multi-celled nodes
# for "rows: 2;" still output "rows: 2;", because it is shorter
if (exists $new->{columns})
{
$new->{size} = ($new->{columns}||1) . ',' . ($new->{rows}||1);
delete $new->{rows};
delete $new->{columns};
# don't output the default size
delete $new->{size} if $new->{size} eq '1,1';
}
for my $atr (sort keys %$new)
{
next if $atr =~ /^border/; # handled special
$att .= "$atr: $new->{$atr}; ";
}
if (!$self->isa_cell())
{
my $border;
if (!exists $self->{autosplit})
{
$border = $self->border_attribute();
}
else
{
$border = Graph::Easy::_border_attribute(
$attributes->{borderstyle}||'',
$attributes->{borderwidth}||'',
$attributes->{bordercolor}||'');
}
# XXX TODO: should do this for all attributes, not only for border
# XXX TODO: this seems wrong anyway
# don't include default border
$border = '' if ref $g && $g->attribute($class,'border') eq $border;
$att .= "border: $border; " if $border ne '';
}
# if we have a subclass, we probably need to include it
my $c = '';
$c = $1 if $class =~ /\.(\w+)/;
# but we do not need to include it if our group has a nodeclass attribute
$c = '' if ref($self->{group}) && $self->{group}->attribute('nodeclass') eq $c;
# include our subclass as attribute
$att .= "class: $c; " if $c ne '' && $c ne 'anon';
# generate attribute text if nec.
$att = ' { ' . $att . '}' if $att ne '';
$att;
}
sub _as_part_txt
{
# for edges, we need the name of the part of the first part, not the entire
# autosplit text
my $self = shift;
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]';
}
sub as_pure_txt
{
my $self = shift;
if (exists $self->{autosplit} && defined $self->{autosplit})
{
my $name = $self->{autosplit};
# quote special chars in name (but not |)
$name =~ s/([\[\]\{\}\#])/\\$1/g;
return '[ '. $name .' ]'
}
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]';
}
sub as_txt
{
my $self = shift;
if (exists $self->{autosplit})
{
return '' unless defined $self->{autosplit};
my $name = $self->{autosplit};
# quote special chars in name (but not |)
$name =~ s/([\[\]\{\}\#])/\\$1/g;
return '[ ' . $name . ' ]'
}
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]' . $self->attributes_as_txt();
}
#############################################################################
package Graph::Easy::Edge;
my $styles = {
solid => '--',
dotted => '..',
double => '==',
'double-dash' => '= ',
dashed => '- ',
'dot-dash' => '.-',
'dot-dot-dash' => '..-',
wave => '~~',
};
sub _as_txt
{
my $self = shift;
# '- Name ' or ''
my $n = $self->{att}->{label}; $n = '' unless defined $n;
my $left = ' '; $left = ' <' if $self->{bidirectional};
my $right = '> '; $right = ' ' if $self->{undirected};
my $s = $self->style() || 'solid';
my $style = '--';
# suppress border on edges
my $suppress = { all => { label => undef } };
if ($s =~ /^(bold|bold-dash|broad|wide|invisible)\z/)
{
# output "--> { style: XXX; }"
$style = '--';
}
else
{
# output "-->" or "..>" etc
$suppress->{all}->{style} = undef;
$style = $styles->{ $s };
if (!defined $style)
{
require Carp;
Carp::confess ("Unknown edge style '$s'\n");
}
}
$n = $style . " $n " if $n ne '';
# make " - " into " - - "
$style = $style . $style if $self->{undirected} && substr($style,1,1) eq ' ';
# ' - Name -->' or ' --> ' or ' -- '
my $a = $self->attributes_as_txt($suppress) . ' '; $a =~ s/^\s//;
$left . $n . $style . $right . $a;
}
1;
__END__
=head1 NAME
Graph::Easy::As_txt - Generate textual description from graph object
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
print $graph->as_txt();
# prints something like:
# [ Bonn ] -> [ Berlin ]
=head1 DESCRIPTION
C<Graph::Easy::As_txt> contains just the code for converting a
L<Graph::Easy|Graph::Easy> object to a human-readable textual description.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

586
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_vcg.pm Normal file
View File

@@ -0,0 +1,586 @@
#############################################################################
# Output the graph as VCG or GDL text.
#
#############################################################################
package Graph::Easy::As_vcg;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
my $vcg_remap = {
node => {
align => \&_vcg_remap_align,
autolabel => undef,
autolink => undef,
autotitle => undef,
background => undef,
basename => undef,
class => undef,
colorscheme => undef,
columns => undef,
flow => undef,
fontsize => undef,
format => undef,
group => undef,
id => undef,
link => undef,
linkbase => undef,
offset => undef,
origin => undef,
pointstyle => undef,
rank => 'level',
rotate => undef,
rows => undef,
shape => \&_vcg_remap_shape,
size => undef,
textstyle => undef,
textwrap => undef,
title => undef,
},
edge => {
color => 'color', # this entry overrides 'all'!
align => undef,
arrowshape => undef,
arrowstyle => undef,
autojoin => undef,
autolabel => undef,
autolink => undef,
autosplit => undef,
autotitle => undef,
border => undef,
bordercolor => undef,
borderstyle => undef,
borderwidth => undef,
colorscheme => undef,
end => undef,
fontsize => undef,
format => undef,
id => undef,
labelcolor => 'textcolor',
link => undef,
linkbase => undef,
minlen => undef,
start => undef,
# XXX TODO: remap unknown styles
style => 'linestyle',
textstyle => undef,
textwrap => undef,
title => undef,
},
graph => {
align => \&_vcg_remap_align,
flow => \&_vcg_remap_flow,
label => 'title',
type => undef,
},
group => {
},
all => {
background => undef,
color => 'textcolor',
comment => undef,
fill => 'color',
font => 'fontname',
},
always => {
},
# this routine will handle all custom "x-dot-..." attributes
x => \&_remap_custom_vcg_attributes,
};
sub _remap_custom_vcg_attributes
{
my ($self, $name, $value) = @_;
# drop anything that is not starting with "x-vcg-..."
return (undef,undef) unless $name =~ /^x-vcg-/;
$name =~ s/^x-vcg-//; # "x-vcg-foo" => "foo"
($name,$value);
}
my $vcg_shapes = {
rect => 'box',
diamond => 'rhomb',
triangle => 'triangle',
invtriangle => 'triangle',
ellipse => 'ellipse',
circle => 'circle',
hexagon => 'hexagon',
trapezium => 'trapeze',
invtrapezium => 'uptrapeze',
invparallelogram => 'lparallelogram',
parallelogram => 'rparallelogram',
};
sub _vcg_remap_shape
{
my ($self, $name, $shape) = @_;
return ('invisible','yes') if $shape eq 'invisible';
('shape', $vcg_shapes->{$shape} || 'box');
}
sub _vcg_remap_align
{
my ($self, $name, $style) = @_;
# center => center, left => left_justify, right => right_justify
$style .= '_justify' unless $style eq 'center';
('textmode', $style);
}
my $vcg_flow = {
'south' => 'top_to_bottom',
'north' => 'bottom_to_top',
'down' => 'top_to_bottom',
'up' => 'bottom_to_top',
'east' => 'left_to_right',
'west' => 'right_to_left',
'right' => 'left_to_right',
'left' => 'right_to_left',
};
sub _vcg_remap_flow
{
my ($self, $name, $style) = @_;
('orientation', $vcg_flow->{$style} || 'top_to_bottom');
}
sub _class_attributes_as_vcg
{
# convert a hash with attribute => value mappings to a string
my ($self, $a, $class) = @_;
my $att = '';
$class = '' if $class eq 'graph';
$class .= '.' if $class ne '';
# create the attributes as text:
for my $atr (sort keys %$a)
{
my $v = $a->{$atr};
$v =~ s/"/\\"/g; # '2"' => '2\"'
$v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/; # 1, "1a"
$att .= " $class$atr: $v\n";
}
$att =~ s/,\s$//; # remove last ","
$att = "\n$att" unless $att eq '';
$att;
}
#############################################################################
sub _generate_vcg_edge
{
# Given an edge, generate the VCG code for it
my ($self, $e, $indent) = @_;
# skip links from/to groups, these will be done later
return '' if
$e->{from}->isa('Graph::Easy::Group') ||
$e->{to}->isa('Graph::Easy::Group');
my $edge_att = $e->attributes_as_vcg();
$e->{_p} = undef; # mark as processed
" edge:$edge_att\n"; # return edge text
}
use Graph::Easy::Util qw(ord_values);
sub _as_vcg
{
my ($self) = @_;
# convert the graph to a textual representation
# does not need a layout() beforehand!
# gather all edge classes to build the classname attribute from them:
$self->{_vcg_edge_classes} = {};
for my $e (ord_values ( $self->{edges} ))
{
my $class = $e->sub_class();
$self->{_vcg_edge_classes}->{$class} = undef if defined $class && $class ne '';
}
# sort gathered class names and map them to integers
my $class_names = '';
if (keys %{$self->{_vcg_edge_classes}} > 0)
{
my $i = 1;
$class_names = "\n";
for my $ec (sort keys %{$self->{_vcg_edge_classes}})
{
$self->{_vcg_edge_classes}->{$ec} = $i; # remember mapping
$class_names .= " classname $i: \"$ec\"\n";
$i++;
}
}
# generate the class attributes first
my $label = $self->label();
my $t = ''; $t = "\n title: \"$label\"" if $label ne '';
my $txt = "graph: {$t\n\n" .
" // Generated by Graph::Easy $Graph::Easy::VERSION" .
" at " . scalar localtime() . "\n" .
$class_names;
my $groups = $self->groups();
# to keep track of invisible helper nodes
$self->{_vcg_invis} = {};
# name for invisible helper nodes
$self->{_vcg_invis_id} = 'joint0';
my $atts = $self->{att};
# insert the class attributes
for my $class (qw/edge graph node/)
{
next if $class =~ /\./; # skip subclasses
my $out = $self->_remap_attributes( $class, $atts->{$class}, $vcg_remap, 'noquote');
$txt .= $self->_class_attributes_as_vcg($out, $class);
}
$txt .= "\n" if $txt ne ''; # insert newline
###########################################################################
# output groups as subgraphs
# insert the edges into the proper group
$self->_edges_into_groups() if $groups > 0;
# output the groups (aka subclusters)
my $indent = ' ';
for my $group (sort { $a->{name} cmp $b->{name} } values %{$self->{groups}})
{
# quote special chars in group name
my $name = $group->{name}; $name =~ s/([\[\]\(\)\{\}\#"])/\\$1/g;
# # output group attributes first
# $txt .= " subgraph \"cluster$group->{id}\" {\n${indent}label=\"$name\";\n";
# Make a copy of the attributes, including our class attributes:
my $copy = {};
my $attribs = $group->get_attributes();
for my $a (keys %$attribs)
{
$copy->{$a} = $attribs->{$a};
}
# # set some defaults
# $copy->{'borderstyle'} = 'solid' unless defined $copy->{'borderstyle'};
my $out = {};
# my $out = $self->_remap_attributes( $group->class(), $copy, $vcg_remap, 'noquote');
# Set some defaults:
$out->{fillcolor} = '#a0d0ff' unless defined $out->{fillcolor};
# $out->{labeljust} = 'l' unless defined $out->{labeljust};
my $att = '';
# we need to output style first ("filled" and "color" need come later)
for my $atr (reverse sort keys %$out)
{
my $v = $out->{$atr};
$v = '"' . $v . '"';
$att .= " $atr: $v\n";
}
$txt .= $att . "\n" if $att ne '';
# # output nodes (w/ or w/o attributes) in that group
# for my $n ($group->sorted_nodes())
# {
# my $att = $n->attributes_as_vcg();
# $n->{_p} = undef; # mark as processed
# $txt .= $indent . $n->as_graphviz_txt() . $att . "\n";
# }
# # output node connections in this group
# for my $e (ord_values ( $group->{edges} ))
# {
# next if exists $e->{_p};
# $txt .= $self->_generate_edge($e, $indent);
# }
$txt .= " }\n";
}
my $root = $self->attribute('root');
$root = '' unless defined $root;
my $count = 0;
# output nodes with attributes first, sorted by their name
for my $n (sort { $a->{name} cmp $b->{name} } values %{$self->{nodes}})
{
next if exists $n->{_p};
my $att = $n->attributes_as_vcg($root);
if ($att ne '')
{
$n->{_p} = undef; # mark as processed
$count++;
$txt .= " node:" . $att . "\n";
}
}
$txt .= "\n" if $count > 0; # insert a newline
my @nodes = $self->sorted_nodes();
foreach my $n (@nodes)
{
my @out = $n->successors();
my $first = $n->as_vcg_txt();
if ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0))
{
# single node without any connections (unless already output)
$txt .= " node: { title: " . $first . " }\n" unless exists $n->{_p};
}
# for all outgoing connections
foreach my $other (reverse @out)
{
# in case there is more than one edge going from N to O
my @edges = $n->edges_to($other);
foreach my $e (@edges)
{
next if exists $e->{_p};
$txt .= $self->_generate_vcg_edge($e, ' ');
}
}
}
# insert now edges between groups (clusters/subgraphs)
# foreach my $e (ord_values ( $self->{edges} ))
# {
# $txt .= $self->_generate_group_edge($e, ' ')
# if $e->{from}->isa('Graph::Easy::Group') ||
# $e->{to}->isa('Graph::Easy::Group');
# }
# clean up
for my $n ( ord_values ( $self->{nodes} ), ord_values ( $self->{edges} ))
{
delete $n->{_p};
}
delete $self->{_vcg_invis}; # invisible helper nodes for joints
delete $self->{_vcg_invis_id}; # invisible helper node name
delete $self->{_vcg_edge_classes};
$txt . "\n}\n"; # close the graph
}
package Graph::Easy::Node;
sub attributes_as_vcg
{
# return the attributes of this node as text description
my ($self, $root) = @_;
$root = '' unless defined $root;
my $att = '';
my $class = $self->class();
return '' unless ref $self->{graph};
my $g = $self->{graph};
# get all attributes, excluding the class attributes
my $a = $self->raw_attributes();
# add the attributes that are listed under "always":
my $attr = $self->{att};
my $base_class = $class; $base_class =~ s/\..*//;
my $list = $vcg_remap->{always}->{$class} || $vcg_remap->{always}->{$base_class};
for my $name (@$list)
{
# for speed, try to look it up directly
# look if we have a code ref, if yes, simple set the value to undef
# and let the coderef handle it later:
if ( ref($vcg_remap->{$base_class}->{$name}) ||
ref($vcg_remap->{all}->{$name}) )
{
$a->{$name} = $attr->{$name};
}
else
{
$a->{$name} = $attr->{$name};
$a->{$name} = $self->attribute($name) unless defined $a->{$name} && $a->{$name} ne 'inherit';
}
}
$a = $g->_remap_attributes( $self, $a, $vcg_remap, 'noquote');
if ($self->isa('Graph::Easy::Edge'))
{
$a->{sourcename} = $self->{from}->{name};
$a->{targetname} = $self->{to}->{name};
my $class = $self->sub_class();
$a->{class} = $self->{graph}->{_vcg_edge_classes}->{ $class } if defined $class && $class ne '';
}
else
{
# title: "Bonn"
$a->{title} = $self->{name};
}
# do not needlessly output labels:
delete $a->{label} if !$self->isa('Graph::Easy::Edge') && # not an edge
exists $a->{label} && $a->{label} eq $self->{name};
# bidirectional and undirected edges
if ($self->{bidirectional})
{
delete $a->{dir};
my ($n,$s) = Graph::Easy::_graphviz_remap_arrow_style(
$self,'', $self->attribute('arrowstyle'));
$a->{arrowhead} = $s;
$a->{arrowtail} = $s;
}
if ($self->{undirected})
{
delete $a->{dir};
$a->{arrowhead} = 'none';
$a->{arrowtail} = 'none';
}
# borderstyle: double:
if (!$self->isa('Graph::Easy::Edge'))
{
my $style = $self->attribute('borderstyle');
$a->{peripheries} = 2 if $style =~ /^double/;
}
# For nodes with shape plaintext, set the fillcolor to the background of
# the graph/group
my $shape = $a->{shape} || 'rect';
if ($class =~ /node/ && $shape eq 'plaintext')
{
my $p = $self->parent();
$a->{fillcolor} = $p->attribute('fill');
$a->{fillcolor} = 'white' if $a->{fillcolor} eq 'inherit';
}
$shape = $self->attribute('shape') unless $self->isa_cell();
# for point-shaped nodes, include the point as label and set width/height
if ($shape eq 'point')
{
require Graph::Easy::As_ascii; # for _u8 and point-style
my $style = $self->_point_style( $self->attribute('pointstyle') );
$a->{label} = $style;
# for point-shaped invisible nodes, set height/width = 0
$a->{width} = 0, $a->{height} = 0 if $style eq '';
}
if ($shape eq 'invisible')
{
$a->{label} = ' ';
}
$a->{rank} = '0' if $root ne '' && $root eq $self->{name};
# create the attributes as text:
for my $atr (sort keys %$a)
{
my $v = $a->{$atr};
$v =~ s/"/\\"/g; # '2"' => '2\"'
$v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/; # 1, "1a"
$att .= "$atr: $v ";
}
$att =~ s/,\s$//; # remove last ","
# generate attribute text if nec.
$att = ' { ' . $att . '}' if $att ne '';
$att;
}
sub as_vcg_txt
{
# return the node itself (w/o attributes) as VCG representation
my $self = shift;
my $name = $self->{name};
# escape special chars in name (including doublequote!)
$name =~ s/([\[\]\(\)\{\}"])/\\$1/g;
# quote:
'"' . $name . '"';
}
1;
__END__
=head1 NAME
Graph::Easy::As_vcg - Generate VCG/GDL text from Graph::Easy object
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
print $graph->as_vcg();
This prints something like this:
graph: {
node: { title: "Bonn" }
node: { title: "Berlin" }
edge: { sourcename: "Bonn" targetname: "Berlin" }
}
=head1 DESCRIPTION
C<Graph::Easy::As_vcg> contains just the code for converting a
L<Graph::Easy|Graph::Easy> object to either a VCG
or GDL textual description.
Note that the generated format is compatible to C<GDL> aka I<Graph
Description Language>.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>, L<http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html>.
=head1 AUTHOR
Copyright (C) 2004-2008 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

4182
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Attributes.pm Normal file
View File

File diff suppressed because it is too large Load Diff

486
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Base.pm Normal file
View File

@@ -0,0 +1,486 @@
#############################################################################
# A baseclass for Graph::Easy objects like nodes, edges etc.
#
#############################################################################
package Graph::Easy::Base;
$VERSION = '0.76';
use strict;
use warnings;
#############################################################################
{
# protected vars
my $id = 0;
sub _new_id { $id++; }
sub _reset_id { $id = 0; }
}
#############################################################################
sub new
{
# Create a new object. This is a generic routine that is inherited
# by many other things like Edge, Cell etc.
my $self = bless { id => _new_id() }, shift;
my $args = $_[0];
$args = { name => $_[0] } if ref($args) ne 'HASH' && @_ == 1;
$args = { @_ } if ref($args) ne 'HASH' && @_ > 1;
$self->_init($args);
}
sub _init
{
# Generic init routine, to be overriden in subclasses.
my ($self,$args) = @_;
$self;
}
sub self
{
my $self = shift;
$self;
}
#############################################################################
sub no_fatal_errors
{
my $self = shift;
$self->{fatal_errors} = ($_[1] ? 1 : 0) if @_ > 0;
~ ($self->{fatal_errors} || 0);
}
sub fatal_errors
{
my $self = shift;
$self->{fatal_errors} = ($_[1] ? 0 : 1) if @_ > 0;
$self->{fatal_errors} || 0;
}
sub error
{
my $self = shift;
# If we switched to a temp. Graphviz parser, then set the error on the
# original parser object, too:
$self->{_old_self}->error(@_) if ref($self->{_old_self});
# if called on a member on a graph, call error() on the graph itself:
return $self->{graph}->error(@_) if ref($self->{graph});
if (defined $_[0])
{
$self->{error} = $_[0];
if ($self->{_catch_errors})
{
push @{$self->{_errors}}, $self->{error};
}
else
{
$self->_croak($self->{error}, 2)
if ($self->{fatal_errors}) && $self->{error} ne '';
}
}
$self->{error} || '';
}
sub error_as_html
{
# return error() properly escaped
my $self = shift;
my $msg = $self->{error};
$msg =~ s/&/&amp;/g;
$msg =~ s/</&lt;/g;
$msg =~ s/>/&gt;/g;
$msg =~ s/"/&quot;/g;
$msg;
}
sub catch_messages
{
# Catch all warnings (and errors if no_fatal_errors() was used)
# these can later be retrieved with warnings() and errors():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_warnings} = 1;
$self->{_catch_errors} = 1;
$self->{_warnings} = [];
$self->{_errors} = [];
}
else
{
$self->{_catch_warnings} = 0;
$self->{_catch_errors} = 0;
}
}
$self;
}
sub catch_warnings
{
# Catch all warnings
# these can later be retrieved with warnings():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_warnings} = 1;
$self->{_warnings} = [];
}
else
{
$self->{_catch_warnings} = 0;
}
}
$self->{_catch_warnings};
}
sub catch_errors
{
# Catch all errors
# these can later be retrieved with errors():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_errors} = 1;
$self->{_errors} = [];
}
else
{
$self->{_catch_errors} = 0;
}
}
$self->{_catch_errors};
}
sub warnings
{
# return all warnings that occurred after catch_messages(1)
my $self = shift;
@{$self->{_warnings}};
}
sub errors
{
# return all errors that occurred after catch_messages(1)
my $self = shift;
@{$self->{_errors}};
}
sub warn
{
my ($self, $msg) = @_;
if ($self->{_catch_warnings})
{
push @{$self->{_warnings}}, $msg;
}
else
{
require Carp;
Carp::carp('Warning: ' . $msg);
}
}
sub _croak
{
my ($self, $msg, $level) = @_;
$level = 1 unless defined $level;
require Carp;
if (ref($self) && $self->{debug})
{
$Carp::CarpLevel = $level; # don't report Base itself
Carp::confess($msg);
}
else
{
Carp::croak($msg);
}
}
#############################################################################
# class management
sub sub_class
{
# get/set the subclass
my $self = shift;
if (defined $_[0])
{
$self->{class} =~ s/\..*//; # nix subclass
$self->{class} .= '.' . $_[0]; # append new one
delete $self->{cache};
$self->{cache}->{subclass} = $_[0];
$self->{cache}->{class} = $self->{class};
return;
}
$self->{class} =~ /\.(.*)/;
return $1 if defined $1;
return $self->{cache}->{subclass} if defined $self->{cache}->{subclass};
# Subclass not defined, so check our base class for a possible set class
# attribute and return this:
# take a shortcut
my $g = $self->{graph};
if (defined $g)
{
my $subclass = $g->{att}->{$self->{class}}->{class};
$subclass = '' unless defined $subclass;
$self->{cache}->{subclass} = $subclass;
$self->{cache}->{class} = $self->{class};
return $subclass;
}
# not part of a graph?
$self->{cache}->{subclass} = $self->attribute('class');
}
sub class
{
# return our full class name like "node.subclass" or "node"
my $self = shift;
$self->error("class() method does not take arguments") if @_ > 0;
$self->{class} =~ /\.(.*)/;
return $self->{class} if defined $1;
return $self->{cache}->{class} if defined $self->{cache}->{class};
# Subclass not defined, so check our base class for a possible set class
# attribute and return this:
my $subclass;
# take a shortcut:
my $g = $self->{graph};
if (defined $g)
{
$subclass = $g->{att}->{$self->{class}}->{class};
$subclass = '' unless defined $subclass;
}
$subclass = $self->{att}->{class} unless defined $subclass;
$subclass = '' unless defined $subclass;
$self->{cache}->{subclass} = $subclass;
$subclass = '.' . $subclass if $subclass ne '';
$self->{cache}->{class} = $self->{class} . $subclass;
}
sub main_class
{
my $self = shift;
$self->{class} =~ /^(.+?)(\.|\z)/; # extract first part
$1;
}
1;
__END__
=head1 NAME
Graph::Easy::Base - base class for Graph::Easy objects like nodes, edges etc
=head1 SYNOPSIS
package Graph::Easy::My::Node;
use Graph::Easy::Base;
@ISA = qw/Graph::Easy::Base/;
=head1 DESCRIPTION
Used automatically and internally by L<Graph::Easy> - should not be used
directly.
=head1 METHODS
=head2 new()
my $object = Graph::Easy::Base->new();
Create a new object, and call C<_init()> on it.
=head2 error()
$last_error = $object->error();
$object->error($error); # set new messages
$object->error(''); # clear the error
Returns the last error message, or '' for no error.
When setting a new error message, C<< $self->_croak($error) >> will be called
unless C<< $object->no_fatal_errors() >> is true.
=head2 error_as_html()
my $error = $object->error_as_html();
Returns the same error message as L<error()>, but properly escaped
as HTML so it is safe to output to the client.
=head2 warn()
$object->warn('Warning!');
Warn on STDERR with the given message.
=head2 no_fatal_errors()
$object->no_fatal_errors(1);
Set the flag that determines whether setting an error message
via C<error()> is fatal, e.g. results in a call to C<_croak()>.
A true value will make errors non-fatal. See also L<fatal_errors>.
=head2 fatal_errors()
$fatal = $object->fatal_errors();
$object->fatal_errors(0); # turn off
$object->fatal_errors(1); # turn on
Set/get the flag that determines whether setting an error message
via C<error()> is fatal, e.g. results in a call to C<_croak()>.
A true value makes errors fatal.
=head2 catch_errors()
my $catch_errors = $object->catch_errors(); # query
$object->catch_errors(1); # enable
$object->...(); # some error
if ($object->error())
{
my @errors = $object->errors(); # retrieve
}
Enable/disable catching of all error messages. When enabled,
all previously caught error messages are thrown away, and from this
poin on new errors are non-fatal and stored internally. You can
retrieve these errors later with the errors() method.
=head2 catch_warnings()
my $catch_warns = $object->catch_warnings(); # query
$object->catch_warnings(1); # enable
$object->...(); # some error
if ($object->warning())
{
my @warnings = $object->warnings(); # retrieve
}
Enable/disable catching of all warnings. When enabled, all previously
caught warning messages are thrown away, and from this poin on new
warnings are stored internally. You can retrieve these errors later
with the errors() method.
=head2 catch_messages()
# catch errors and warnings
$object->catch_messages(1);
# stop catching errors and warnings
$object->catch_messages(0);
A true parameter is equivalent to:
$object->catch_warnings(1);
$object->catch_errors(1);
See also: L<catch_warnings()> and L<catch_errors()> as well as
L<errors()> and L<warnings()>.
=head2 errors()
my @errors = $object->errors();
Return all error messages that occurred after L<catch_messages()> was
called.
=head2 warnings()
my @warnings = $object->warnings();
Return all warning messages that occurred after L<catch_messages()>
or L<catch_errors()> was called.
=head2 self()
my $self = $object->self();
Returns the object itself.
=head2 class()
my $class = $object->class();
Returns the full class name like C<node.cities>. See also C<sub_class>.
=head2 sub_class()
my $sub_class = $object->sub_class();
Returns the sub class name like C<cities>. See also C<class>.
=head2 main_class()
my $main_class = $object->main_class();
Returns the main class name like C<node>. See also C<sub_class>.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
X<tels>
X<bloodgate>
X<license>
X<gpl>
=cut

751
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Edge.pm Normal file
View File

@@ -0,0 +1,751 @@
#############################################################################
# An edge connecting two nodes in Graph::Easy.
#
#############################################################################
package Graph::Easy::Edge;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/; # an edge is just a special node
$VERSION = '0.76';
use strict;
use warnings;
use constant isa_cell => 1;
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = 'edge';
# leave this unitialized until we need it
# $self->{cells} = [ ];
foreach my $k (sort keys %$args)
{
if ($k !~ /^(label|name|style)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
}
my $n = $k; $n = 'label' if $k eq 'name';
$self->{att}->{$n} = $args->{$k};
}
$self;
}
#############################################################################
# accessor methods
sub bidirectional
{
my $self = shift;
if (@_ > 0)
{
my $old = $self->{bidirectional} || 0;
$self->{bidirectional} = $_[0] ? 1 : 0;
# invalidate layout?
$self->{graph}->{score} = undef if $old != $self->{bidirectional} && ref($self->{graph});
}
$self->{bidirectional};
}
sub undirected
{
my $self = shift;
if (@_ > 0)
{
my $old = $self->{undirected} || 0;
$self->{undirected} = $_[0] ? 1 : 0;
# invalidate layout?
$self->{graph}->{score} = undef if $old != $self->{undirected} && ref($self->{graph});
}
$self->{undirected};
}
sub has_ports
{
my $self = shift;
my $s_port = $self->{att}->{start} || $self->attribute('start');
return 1 if $s_port ne '';
my $e_port = $self->{att}->{end} || $self->attribute('end');
return 1 if $e_port ne '';
0;
}
sub start_port
{
# return the side and portnumber if the edge has a shared source port
# undef for none
my $self = shift;
my $s = $self->{att}->{start} || $self->attribute('start');
return undef if !defined $s || $s !~ /,/; # "south, 0" => ok, "south" => no
return (split /\s*,\s*/, $s) if wantarray;
$s =~ s/\s+//g; # remove spaces to normalize "south, 0" to "south,0"
$s;
}
sub end_port
{
# return the side and portnumber if the edge has a shared source port
# undef for none
my $self = shift;
my $s = $self->{att}->{end} || $self->attribute('end');
return undef if !defined $s || $s !~ /,/; # "south, 0" => ok, "south" => no
return split /\s*,\s*/, $s if wantarray;
$s =~ s/\s+//g; # remove spaces to normalize "south, 0" to "south,0"
$s;
}
sub style
{
my $self = shift;
$self->{att}->{style} || $self->attribute('style');
}
sub name
{
# returns actually the label
my $self = shift;
$self->{att}->{label} || '';
}
#############################################################################
# cell management - used by the cell-based layouter
sub _cells
{
# return all the cells this edge currently occupies
my $self = shift;
$self->{cells} = [] unless defined $self->{cells};
@{$self->{cells}};
}
sub _clear_cells
{
# remove all belonging cells
my $self = shift;
$self->{cells} = [];
$self;
}
sub _unplace
{
# Take an edge, and remove all the cells it covers from the cells area
my ($self, $cells) = @_;
print STDERR "# clearing path from $self->{from}->{name} to $self->{to}->{name}\n" if $self->{debug};
for my $key (@{$self->{cells}})
{
# XXX TODO: handle crossed edges differently (from CROSS => HOR or VER)
# free in our cells area
delete $cells->{$key};
}
$self->clear_cells();
$self;
}
sub _distance
{
# estimate the distance from SRC to DST node
my ($self) = @_;
my $src = $self->{from};
my $dst = $self->{to};
# one of them not yet placed?
return 100000 unless defined $src->{x} && defined $dst->{x};
my $cells = $self->{graph}->{cells};
# get all the starting positions
# distance = 1: slots, generate starting types, the direction is shifted
# by 90° counter-clockwise
my @start = $src->_near_places($cells, 1, undef, undef, $src->_shift(-90) );
# potential stop positions
my @stop = $dst->_near_places($cells, 1); # distance = 1: slots
my ($s_p,@ss_p) = $self->port('start');
my ($e_p,@ee_p) = $self->port('end');
# the edge has a port description, limiting the start places
@start = $src->_allowed_places( \@start, $src->_allow( $s_p, @ss_p ), 3)
if defined $s_p;
# the edge has a port description, limiting the stop places
@stop = $dst->_allowed_places( \@stop, $dst->_allow( $e_p, @ee_p ), 3)
if defined $e_p;
my $stop = scalar @stop;
return 0 unless @stop > 0 && @start > 0; # no free slots on one node?
my $lowest;
my $i = 0;
while ($i < scalar @start)
{
my $sx = $start[$i]; my $sy = $start[$i+1]; $i += 2;
# for each start point, calculate the distance to each stop point, then use
# the smallest as value
for (my $u = 0; $u < $stop; $u += 2)
{
my $dist = Graph::Easy::_astar_distance($sx,$sy, $stop[$u], $stop[$u+1]);
$lowest = $dist if !defined $lowest || $dist < $lowest;
}
}
$lowest;
}
sub _add_cell
{
# add a cell to the list of cells this edge covers. If $after is a ref
# to a cell, then the new cell will be inserted right after this cell.
# if after is defined, but not a ref, the new cell will be inserted
# at the specified position.
my ($self, $cell, $after, $before) = @_;
$self->{cells} = [] unless defined $self->{cells};
my $cells = $self->{cells};
# if both are defined, but belong to different edges, just ignore $before:
$before = undef if ref($before) && $before->{edge} != $self;
$after = undef if ref($after) && $after->{edge} != $self;
if (!defined $after && ref($before))
{
$after = $before; $before = undef;
}
if (defined $after)
{
# insert the new cell right after $after
my $ofs = $after;
if (ref($after) && !ref($before))
{
# insert after $after
$ofs = 1;
for my $cell (@$cells)
{
last if $cell == $after;
$ofs++;
}
}
elsif (ref($after) && ref($before))
{
# insert between after and before (or before/after for "reversed edges)
$ofs = 0;
my $found = 0;
while ($ofs < scalar @$cells - 1) # 0,1,2,3 => 0 .. 2
{
my $c1 = $cells->[$ofs];
my $c2 = $cells->[$ofs+1];
$ofs++;
$found++, last if (($c1 == $after && $c2 == $before) ||
($c1 == $before && $c2 == $after));
}
if (!$found)
{
# XXX TODO: last effort
# insert after $after
$ofs = 1;
for my $cell (@$cells)
{
last if $cell == $after;
$ofs++;
}
$found++;
}
$self->_croak("Could not find $after and $before") unless $found;
}
splice (@$cells, $ofs, 0, $cell);
}
else
{
# insert new cell at the end
push @$cells, $cell;
}
$cell->_update_boundaries();
$self;
}
#############################################################################
sub from
{
my $self = shift;
$self->{from};
}
sub to
{
my $self = shift;
$self->{to};
}
sub nodes
{
my $self = shift;
($self->{from}, $self->{to});
}
sub start_at
{
# move the edge's start point from the current node to the given node
my ($self, $node) = @_;
# if not a node yet, or not part of this graph, make into one proper node
$node = $self->{graph}->add_node($node);
$self->_croak("start_at() needs a node object, but got $node")
unless ref($node) && $node->isa('Graph::Easy::Node');
# A => A => nothing to do
return $node if $self->{from} == $node;
# delete self at A
delete $self->{from}->{edges}->{ $self->{id} };
# set "from" to B
$self->{from} = $node;
# add to B
$self->{from}->{edges}->{ $self->{id} } = $self;
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
# return new start point
$node;
}
sub end_at
{
# move the edge's end point from the current node to the given node
my ($self, $node) = @_;
# if not a node yet, or not part of this graph, make into one proper node
$node = $self->{graph}->add_node($node);
$self->_croak("start_at() needs a node object, but got $node")
unless ref($node) && $node->isa('Graph::Easy::Node');
# A => A => nothing to do
return $node if $self->{to} == $node;
# delete self at A
delete $self->{to}->{edges}->{ $self->{id} };
# set "to" to B
$self->{to} = $node;
# add to node B
$self->{to}->{edges}->{ $self->{id} } = $self;
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
# return new end point
$node;
}
sub edge_flow
{
# return the flow at this edge or '' if the edge itself doesn't have a flow
my $self = shift;
# our flow comes from ourselves
my $flow = $self->{att}->{flow};
$flow = $self->raw_attribute('flow') unless defined $flow;
$flow;
}
sub flow
{
# return the flow at this edge (including inheriting flow from node)
my ($self) = @_;
# print STDERR "# flow from $self->{from}->{name} to $self->{to}->{name}\n";
# our flow comes from ourselves
my $flow = $self->{att}->{flow};
# or maybe our class
$flow = $self->raw_attribute('flow') unless defined $flow;
# if the edge doesn't have a flow, maybe the node has a default out flow
$flow = $self->{from}->{att}->{flow} if !defined $flow;
# if that didn't work out either, use the parents flows
$flow = $self->parent()->attribute('flow') if !defined $flow;
# or finally, the default "east":
$flow = 90 if !defined $flow;
# absolute flow does not depend on the in-flow, so can return early
return $flow if $flow =~ /^(0|90|180|270)\z/;
# in-flow comes from our "from" node
my $in = $self->{from}->flow();
# print STDERR "# in: $self->{from}->{name} = $in\n";
my $out = $self->{graph}->_flow_as_direction($in,$flow);
$out;
}
sub port
{
my ($self, $which) = @_;
$self->_croak("'$which' must be one of 'start' or 'end' in port()") unless $which =~ /^(start|end)/;
# our flow comes from ourselves
my $sp = $self->attribute($which);
return (undef,undef) unless defined $sp && $sp ne '';
my ($side, $port) = split /\s*,\s*/, $sp;
# if absolut direction, return as is
my $s = Graph::Easy->_direction_as_side($side);
if (defined $s)
{
my @rc = ($s); push @rc, $port if defined $port;
return @rc;
}
# in_flow comes from our "from" node
my $in = 90; $in = $self->{from}->flow() if ref($self->{from});
# turn left in "south" etc:
$s = Graph::Easy->_flow_as_side($in,$side);
my @rc = ($s); push @rc, $port if defined $port;
@rc;
}
sub flip
{
# swap from and to for this edge
my ($self) = @_;
($self->{from}, $self->{to}) = ($self->{to}, $self->{from});
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
$self;
}
sub as_ascii
{
my ($self, $x,$y) = @_;
# invisible nodes, or very small ones
return '' if $self->{w} == 0 || $self->{h} == 0;
my $fb = $self->_framebuffer($self->{w}, $self->{h});
###########################################################################
# "draw" the label into the framebuffer (e.g. the edge and the text)
$self->_draw_label($fb, $x, $y, '');
join ("\n", @$fb);
}
sub as_txt
{
require Graph::Easy::As_ascii;
_as_txt(@_);
}
1;
__END__
=head1 NAME
Graph::Easy::Edge - An edge (a path connecting one ore more nodes)
=head1 SYNOPSIS
use Graph::Easy;
my $ssl = Graph::Easy::Edge->new(
label => 'encrypted connection',
style => 'solid',
);
$ssl->set_attribute('color', 'red');
my $src = Graph::Easy::Node->new('source');
my $dst = Graph::Easy::Node->new('destination');
$graph = Graph::Easy->new();
$graph->add_edge($src, $dst, $ssl);
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Edge> represents an edge between two (or more) nodes in a
simple graph.
Each edge has a direction (from source to destination, or back and forth),
plus a style (line width and style), colors etc. It can also have a label,
e.g. a text associated with it.
During the layout phase, each edge also contains a list of path-elements
(also called cells), which make up the path from source to destination.
=head1 METHODS
=head2 error()
$last_error = $edge->error();
$cvt->error($error); # set new messages
$cvt->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $edge->as_ascii();
Returns the edge as a little ascii representation.
=head2 as_txt()
my $txt = $edge->as_txt();
Returns the edge as a little Graph::Easy textual representation.
=head2 label()
my $label = $edge->label();
Returns the label (also known as 'name') of the edge.
=head2 name()
my $label = $edge->name();
To make the interface more consistent, the C<name()> method of
an edge can also be called, and it will returned either the edge
label, or the empty string if the edge doesn't have a label.
=head2 style()
my $style = $edge->style();
Returns the style of the edge, like 'solid', 'dotted', 'double', etc.
=head2 nodes()
my @nodes = $edge->nodes();
Returns the source and target node that this edges connects as objects.
=head2 bidirectional()
$edge->bidirectional(1);
if ($edge->bidirectional())
{
}
Returns true if the edge is bidirectional, aka has arrow heads on both ends.
An optional parameter will set the bidirectional status of the edge.
=head2 undirected()
$edge->undirected(1);
if ($edge->undirected())
{
}
Returns true if the edge is undirected, aka has now arrow at all.
An optional parameter will set the undirected status of the edge.
=head2 has_ports()
if ($edge->has_ports())
{
...
}
Return true if the edge has restriction on the starting or ending
port, e.g. either the C<start> or C<end> attribute is set on
this edge.
=head2 start_port()
my $port = $edge->start_port();
Return undef if the edge does not have a fixed start port, otherwise
returns the port as "side, number", for example "south, 0".
=head2 end_port()
my $port = $edge->end_port();
Return undef if the edge does not have a fixed end port, otherwise
returns the port as "side, number", for example "south, 0".
=head2 from()
my $from = $edge->from();
Returns the node that this edge starts at. See also C<to()>.
=head2 to()
my $to = $edge->to();
Returns the node that this edge leads to. See also C<from()>.
=head2 start_at()
$edge->start_at($other);
my $other = $edge->start_at('some node');
Set the edge's start point to the given node. If given a node name,
will add that node to the graph first.
Returns the new edge start point node.
=head2 end_at()
$edge->end_at($other);
my $other = $edge->end_at('some other node');
Set the edge's end point to the given node. If given a node name,
will add that node to the graph first.
Returns the new edge end point node.
=head2 flip()
$edge->flip();
Swaps the C<start> and C<end> nodes on this edge, e.g. reverses the direction
of the edge.
X<transpose>
=head2 flow()
my $flow = $edge->flow();
Returns the flow for this edge, honoring inheritance. An edge without
a specific flow set will inherit the flow from the node it comes from.
=head2 edge_flow()
my $flow = $edge->edge_flow();
Returns the flow for this edge, or undef if it has none set on either
the object itself or its class.
=head2 port()
my ($side, $number) = $edge->port('start');
my ($side, $number) = $edge->port('end');
Return the side and port number where this edge starts or ends.
Returns undef for $side if the edge has no port restriction. The
returned side will be one absolute direction of C<east>, C<west>,
C<north> or C<south>, depending on the port restriction and
flow at that edge.
=head2 get_attributes()
my $att = $object->get_attributes();
Return all effective attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance and default values.
See also L<raw_attributes()>.
=head2 raw_attributes()
my $att = $object->get_attributes();
Return all set attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance, but does not include
default values for unset attributes.
See also L<get_attributes()>.
=head2 attribute related methods
You can call all the various attribute related methods like C<set_attribute()>,
C<get_attribute()>, etc. on an edge, too. For example:
$edge->set_attribute('label', 'by train');
my $attr = $edge->get_attributes();
my $raw_attr = $edge->raw_attributes();
You can find more documentation in L<Graph::Easy>.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

1464
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Edge/Cell.pm Normal file
View File

File diff suppressed because it is too large Load Diff

828
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group.pm Normal file
View File

@@ -0,0 +1,828 @@
#############################################################################
# A group of nodes. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Group;
use Graph::Easy::Group::Cell;
use Graph::Easy;
use Scalar::Util qw/weaken/;
@ISA = qw/Graph::Easy::Node Graph::Easy/;
$VERSION = '0.76';
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{name} = 'Group #'. $self->{id};
$self->{class} = 'group';
$self->{_cells} = {}; # the Group::Cell objects
# $self->{cx} = 1;
# $self->{cy} = 1;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(graph|name)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Group->new()");
}
$self->{$k} = $args->{$k};
}
$self->{nodes} = {};
$self->{groups} = {};
$self->{att} = {};
$self;
}
#############################################################################
# accessor methods
sub nodes
{
my $self = shift;
wantarray ? ( ord_values ( $self->{nodes} ) ) : scalar keys %{$self->{nodes}};
}
sub edges
{
# edges leading from/to this group
my $self = shift;
wantarray ? ( ord_values ( $self->{edges} ) ) : scalar keys %{$self->{edges}};
}
sub edges_within
{
# edges between nodes inside this group
my $self = shift;
wantarray ? ( ord_values ( $self->{edges_within} ) ) :
scalar keys %{$self->{edges_within}};
}
sub _groups_within
{
my ($self, $level, $max_level, $cur) = @_;
no warnings 'recursion';
push @$cur, ord_values ( $self->{groups} );
return if $level >= $max_level;
for my $g (ord_values ( $self->{groups} ))
{
$g->_groups_within($level+1,$max_level, $cur) if scalar keys %{$g->{groups}} > 0;
}
}
#############################################################################
sub set_attribute
{
my ($self, $name, $val, $class) = @_;
$self->SUPER::set_attribute($name, $val, $class);
# if defined attribute "nodeclass", put our nodes into that class
if ($name eq 'nodeclass')
{
my $class = $self->{att}->{nodeclass};
for my $node (ord_values ( $self->{nodes} ) )
{
$node->sub_class($class);
}
}
$self;
}
sub shape
{
my ($self) = @_;
# $self->{att}->{shape} || $self->attribute('shape');
'';
}
#############################################################################
# node handling
sub add_node
{
# add a node to this group
my ($self,$n) = @_;
if (!ref($n) || !$n->isa("Graph::Easy::Node"))
{
if (!ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
$n = $self->{graph}->add_node($n);
}
$self->{nodes}->{ $n->{name} } = $n;
# if defined attribute "nodeclass", put our nodes into that class
$n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
# register ourselves with the member
$n->{group} = $self;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
$n;
}
sub add_member
{
# add a node or group to this group
my ($self,$n) = @_;
if (!ref($n) || !$n->isa("Graph::Easy::Node"))
{
if (!ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
$n = $self->{graph}->add_node($n);
}
return $self->_add_edge($n) if $n->isa("Graph::Easy::Edge");
return $self->add_group($n) if $n->isa('Graph::Easy::Group');
$self->{nodes}->{ $n->{name} } = $n;
# if defined attribute "nodeclass", put our nodes into that class
my $cl = $self->attribute('nodeclass');
$n->sub_class($cl) if $cl ne '';
# register ourselves with the member
$n->{group} = $self;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
$n;
}
sub del_member
{
# delete a node or group from this group
my ($self,$n) = @_;
# XXX TOOD: groups vs. nodes
my $class = 'nodes'; my $key = 'name';
if ($n->isa('Graph::Easy::Group'))
{
# XXX TOOD: groups vs. nodes
$class = 'groups'; $key = 'id';
}
delete $self->{$class}->{ $n->{$key} };
delete $n->{group}; # unregister us
if ($n->isa('Graph::Easy::Node'))
{
# find all edges that mention this node and drop them from the group
my $edges = $self->{edges_within};
for my $e (ord_values ( $edges))
{
delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
}
}
$self;
}
sub del_node
{
# delete a node from this group
my ($self,$n) = @_;
delete $self->{nodes}->{ $n->{name} };
delete $n->{group}; # unregister us
delete $n->{att}->{group}; # delete the group attribute
# find all edges that mention this node and drop them from the group
my $edges = $self->{edges_within};
for my $e (ord_values ( $edges))
{
delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
}
$self;
}
sub add_nodes
{
my $self = shift;
# make a copy in case of scalars
my @arg = @_;
foreach my $n (@arg)
{
if (!ref($n) && !ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
return $self->error("Cannot add group-object $n to group '$self->{name}'")
if $n->isa('Graph::Easy::Group');
$n = $self->{graph}->add_node($n) unless ref($n);
$self->{nodes}->{ $n->{name} } = $n;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# XXX TODO TEST!
# # if defined attribute "nodeclass", put our nodes into that class
# $n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
# register ourselves with the member
$n->{group} = $self;
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
}
@arg;
}
#############################################################################
sub _del_edge
{
# delete an edge from this group
my ($self,$e) = @_;
delete $self->{edges_within}->{ $e->{id} };
delete $e->{group}; # unregister us
$self;
}
sub _add_edge
{
# add an edge to this group (e.g. when both from/to of this edge belong
# to this group)
my ($self,$e) = @_;
if (!ref($e) || !$e->isa("Graph::Easy::Edge"))
{
return $self->error("Cannot add non edge-object $e to group '$self->{name}'");
}
$self->{edges_within}->{ $e->{id} } = $e;
# if defined attribute "edgeclass", put our edges into that class
my $edge_class = $self->attribute('edgeclass');
$e->sub_class($edge_class) if $edge_class ne '';
# XXX TODO: inline
$self->add_node($e->{from});
$self->add_node($e->{to});
# register us, but don't do weaken() if the ref was already set
weaken($e->{group} = $self) unless defined $e->{group} && $e->{group} == $self;
$e;
}
sub add_edge
{
# Add an edge to the graph of this group, then register it with this group.
my ($self,$from,$to) = @_;
my $g = $self->{graph};
return $self->error("Cannot add edge to group '$self->{name}' without graph")
unless defined $g;
my $edge = $g->add_edge($from,$to);
$self->_add_edge($edge);
}
sub add_edge_once
{
# Add an edge to the graph of this group, then register it with this group.
my ($self,$from,$to) = @_;
my $g = $self->{graph};
return $self->error("Cannot non edge to group '$self->{name}' without graph")
unless defined $g;
my $edge = $g->add_edge_once($from,$to);
# edge already exists => so fetch it
$edge = $g->edge($from,$to) unless defined $edge;
$self->_add_edge($edge);
}
#############################################################################
sub add_group
{
# add a group to us
my ($self,$group) = @_;
# group with that name already exists?
my $name = $group;
$group = $self->{groups}->{ $group } unless ref $group;
# group with that name doesn't exist, so create new one
$group = $self->{graph}->add_group($name) unless ref $group;
# index under the group name for easier lookup
$self->{groups}->{ $group->{name} } = $group;
# make attribute->('group') work
$group->{att}->{group} = $self->{name};
# register group with the graph and ourself
$group->{graph} = $self->{graph};
$group->{group} = $self;
{
no warnings; # don't warn on already weak references
weaken($group->{graph});
weaken($group->{group});
}
$self->{graph}->{score} = undef; # invalidate last layout
$group;
}
# cell management - used by the layouter
sub _cells
{
# return all the cells this group currently occupies
my $self = shift;
$self->{_cells};
}
sub _clear_cells
{
# remove all belonging cells
my $self = shift;
$self->{_cells} = {};
$self;
}
sub _add_cell
{
# add a cell to the list of cells this group covers
my ($self,$cell) = @_;
$cell->_update_boundaries();
$self->{_cells}->{"$cell->{x},$cell->{y}"} = $cell;
$cell;
}
sub _del_cell
{
# delete a cell from the list of cells this group covers
my ($self,$cell) = @_;
delete $self->{_cells}->{"$cell->{x},$cell->{y}"};
delete $cell->{group};
$self;
}
sub _find_label_cell
{
# go through all cells of this group and find one where to attach the label
my $self = shift;
my $g = $self->{graph};
my $align = $self->attribute('align');
my $loc = $self->attribute('labelpos');
# depending on whether the label should be on top or bottom:
my $match = qr/^\s*gt\s*\z/;
$match = qr/^\s*gb\s*\z/ if $loc eq 'bottom';
my $lc; # the label cell
for my $c (ord_values ( $self->{_cells} ))
{
# find a cell where to put the label
next unless $c->{cell_class} =~ $match;
if (defined $lc)
{
if ($align eq 'left')
{
# find top-most, left-most cell
next if $lc->{x} < $c->{x} || $lc->{y} < $c->{y};
}
elsif ($align eq 'center')
{
# just find any top-most cell
next if $lc->{y} < $c->{y};
}
elsif ($align eq 'right')
{
# find top-most, right-most cell
next if $lc->{x} > $c->{x} || $lc->{y} < $c->{y};
}
}
$lc = $c;
}
# find the cell mostly near the center in the found top-row
if (ref($lc) && $align eq 'center')
{
my ($left, $right);
# find left/right most coordinates
for my $c (ord_values ( $self->{_cells} ))
{
next if $c->{y} != $lc->{y};
$left = $c->{x} if !defined $left || $left > $c->{x};
$right = $c->{x} if !defined $right || $right < $c->{x};
}
my $center = int(($right - $left) / 2 + $left);
my $min_dist;
# find the cell mostly near the center in the found top-row
for my $c (ord_values ( $self->{_cells} ))
{
next if $c->{y} != $lc->{y};
# squared to get rid of sign
my $dist = ($center - $c->{x}); $dist *= $dist;
next if defined $min_dist && $dist > $min_dist;
$min_dist = $dist; $lc = $c;
}
}
print STDERR "# Setting label for group '$self->{name}' at $lc->{x},$lc->{y}\n"
if $self->{debug};
$lc->_set_label() if ref($lc);
}
sub layout
{
my $self = shift;
$self->_croak('Cannot call layout() on a Graph::Easy::Group directly.');
}
sub _layout
{
my $self = shift;
###########################################################################
# set local {debug} for groups
local $self->{debug} = $self->{graph}->{debug};
$self->SUPER::_layout();
}
sub _set_cell_types
{
my ($self, $cells) = @_;
# Set the right cell class for all of our cells:
for my $cell (ord_values ( $self->{_cells} ))
{
$cell->_set_type($cells);
}
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Group - A group of nodes (aka subgraph) in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy;
my $bonn = Graph::Easy::Node->new('Bonn');
$bonn->set_attribute('border', 'solid 1px black');
my $berlin = Graph::Easy::Node->new( name => 'Berlin' );
my $cities = Graph::Easy::Group->new(
name => 'Cities',
);
$cities->set_attribute('border', 'dashed 1px blue');
$cities->add_nodes ($bonn);
# $bonn will be ONCE in the group
$cities->add_nodes ($bonn, $berlin);
=head1 DESCRIPTION
A C<Graph::Easy::Group> represents a group of nodes in an C<Graph::Easy>
object. These nodes are grouped together on output.
=head1 METHODS
=head2 new()
my $group = Graph::Easy::Group->new( $options );
Create a new, empty group. C<$options> are the possible options, see
L<Graph::Easy::Node> for a list.
=head2 error()
$last_error = $group->error();
$group->error($error); # set new messages
$group->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $group->as_ascii();
Return the group as a little box drawn in ASCII art as a string.
=head2 name()
my $name = $group->name();
Return the name of the group.
=head2 id()
my $id = $group->id();
Returns the group's unique ID number.
=head2 set_attribute()
$group->set_attribute('border-style', 'none');
Sets the specified attribute of this (and only this!) group to the
specified value.
=head2 add_member()
$group->add_member($node);
$group->add_member($group);
Add the specified object to this group and returns this member. If the
passed argument is a scalar, will treat it as a node name.
Note that each object can only be a member of one group at a time.
=head2 add_node()
$group->add_node($node);
Add the specified node to this group and returns this node.
Note that each object can only be a member of one group at a time.
=head2 add_edge(), add_edge_once()
$group->add_edge($edge); # Graph::Easy::Edge
$group->add_edge($from, $to); # Graph::Easy::Node or
# Graph::Easy::Group
$group->add_edge('From', 'To'); # Scalars
If passed an Graph::Easy::Edge object, moves the nodes involved in
this edge to the group.
if passed two nodes, adds these nodes to the graph (unless they already
exist) and adds an edge between these two nodes. See L<add_edge_once()>
to avoid creating multiple edges.
This method works only on groups that are part of a graph.
Note that each object can only be a member of one group at a time,
and edges are automatically a member of a group if and only if both
the target and the destination node are a member of the same group.
=head2 add_group()
my $inner = $group->add_group('Group name');
my $nested = $group->add_group($group);
Add a group as subgroup to this group and returns this group.
=head2 del_member()
$group->del_member($node);
$group->del_member($group);
Delete the specified object from this group.
=head2 del_node()
$group->del_node($node);
Delete the specified node from this group.
=head2 del_edge()
$group->del_edge($edge);
Delete the specified edge from this group.
=head2 add_nodes()
$group->add_nodes($node, $node2, ... );
Add all the specified nodes to this group and returns them as a list.
=head2 nodes()
my @nodes = $group->nodes();
Returns a list of all node objects that belong to this group.
=head2 edges()
my @edges = $group->edges();
Returns a list of all edge objects that lead to or from this group.
Note: This does B<not> return edges between nodes that are inside the group,
for this see L<edges_within()>.
=head2 edges_within()
my @edges_within = $group->edges_within();
Returns a list of all edge objects that are I<inside> this group, in arbitrary
order. Edges are automatically considered I<inside> a group if their starting
and ending node both are in the same group.
Note: This does B<not> return edges between this group and other groups,
nor edges between this group and nodes outside this group, for this see
L<edges()>.
=head2 groups()
my @groups = $group->groups();
Returns the contained groups of this group as L<Graph::Easy::Group> objects,
in arbitrary order.
=head2 groups_within()
# equivalent to $group->groups():
my @groups = $group->groups_within(); # all
my @toplevel_groups = $group->groups_within(0); # level 0 only
Return the groups that are inside this group, up to the specified level,
in arbitrary order.
The default level is -1, indicating no bounds and thus all contained
groups are returned.
A level of 0 means only the direct children, and hence only the toplevel
groups will be returned. A level 1 means the toplevel groups and their
toplevel children, and so on.
=head2 as_txt()
my $txt = $group->as_txt();
Returns the group as Graph::Easy textual description.
=head2 _find_label_cell()
$group->_find_label_cell();
Called by the layouter once for each group. Goes through all cells of this
group and finds one where to attach the label to. Internal usage only.
=head2 get_attributes()
my $att = $object->get_attributes();
Return all effective attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance and default values.
See also L<raw_attributes()>.
=head2 raw_attributes()
my $att = $object->get_attributes();
Return all set attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance, but does not include
default values for unset attributes.
See also L<get_attributes()>.
=head2 attribute related methods
You can call all the various attribute related methods like C<set_attribute()>,
C<get_attribute()>, etc. on a group, too. For example:
$group->set_attribute('label', 'by train');
my $attr = $group->get_attributes();
You can find more documentation in L<Graph::Easy>.
=head2 layout()
This routine should not be called on groups, it only works on the graph
itself.
=head2 shape()
my $shape = $group->shape();
Returns the shape of the group as string.
=head2 has_as_successor()
if ($group->has_as_successor($other))
{
...
}
Returns true if C<$other> (a node or group) is a successor of this group, e.g.
if there is an edge leading from this group to C<$other>.
=head2 has_as_predecessor()
if ($group->has_as_predecessor($other))
{
...
}
Returns true if the group has C<$other> (a group or node) as predecessor, that
is if there is an edge leading from C<$other> to this group.
=head2 root_node()
my $root = $group->root_node();
Return the root node as L<Graph::Easy::Node> object, if it was
set with the 'root' attribute.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>, L<Graph::Easy::Node>, L<Graph::Easy::Manual>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
See the LICENSE file for more details.
=cut

124
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group/Anon.pm Normal file
View File

@@ -0,0 +1,124 @@
#############################################################################
# (c) by Tels 2004. Part of Graph::Easy. An anonymous group.
#
#############################################################################
package Graph::Easy::Group::Anon;
use Graph::Easy::Group;
use warnings;
@ISA = qw/Graph::Easy::Group/;
$VERSION = '0.76';
use strict;
sub _init
{
my $self = shift;
$self->SUPER::_init(@_);
$self->{name} = 'Group #' . $self->{id};
$self->{class} = 'group.anon';
$self->{att}->{label} = '';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
sub attributes_as_txt
{
my $self = shift;
$self->SUPER::attributes_as_txt( {
node => {
label => undef,
shape => undef,
class => undef,
} } );
}
sub as_pure_txt
{
'( )';
}
sub _as_part_txt
{
'( )';
}
sub as_graphviz_txt
{
my $self = shift;
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
'"' . $name . '"';
}
sub text_styles_as_css
{
'';
}
sub is_anon
{
# is an anon group
1;
}
1;
__END__
=head1 NAME
Graph::Easy::Group::Anon - An anonymous group of nodes in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy::Group::Anon;
my $anon = Graph::Easy::Group::Anon->new();
=head1 DESCRIPTION
A C<Graph::Easy::Group::Anon> represents an anonymous group of nodes,
e.g. a group without a name.
The syntax in the Graph::Easy textual description language looks like this:
( [ Bonn ] -> [ Berlin ] )
This module is loaded and used automatically by Graph::Easy, so there is
no need to use it manually.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy::Group>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

401
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group/Cell.pm Normal file
View File

@@ -0,0 +1,401 @@
#############################################################################
# A cell of a group during layout. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Group::Cell;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
BEGIN
{
*get_attribute = \&attribute;
}
#############################################################################
# The different types for a group-cell:
use constant {
GROUP_INNER => 0, # completely sourounded by group cells
GROUP_RIGHT => 1, # right border only
GROUP_LEFT => 2, # left border only
GROUP_TOP => 3, # top border only
GROUP_BOTTOM => 4, # bottom border only
GROUP_ALL => 5, # completely sourounded by non-group cells
GROUP_BOTTOM_RIGHT => 6, # bottom and right border
GROUP_BOTTOM_LEFT => 7, # bottom and left border
GROUP_TOP_RIGHT => 8, # top and right border
GROUP_TOP_LEFT => 9, # top and left order
GROUP_MAX => 5, # max number
};
my $border_styles =
{
# type top, bottom, left, right, class
GROUP_INNER() => [ 0, 0, 0, 0, ['gi'] ],
GROUP_RIGHT() => [ 0, 0, 0, 1, ['gr'] ],
GROUP_LEFT() => [ 0, 0, 1, 0, ['gl'] ],
GROUP_TOP() => [ 1, 0, 0, 0, ['gt'] ],
GROUP_BOTTOM() => [ 0, 1, 0, 0, ['gb'] ],
GROUP_ALL() => [ 0, 0, 0, 0, ['ga'] ],
GROUP_BOTTOM_RIGHT() => [ 0, 1, 0, 1, ['gb','gr'] ],
GROUP_BOTTOM_LEFT() => [ 0, 1, 1, 0, ['gb','gl'] ],
GROUP_TOP_RIGHT() => [ 1, 0, 0, 1, ['gt','gr'] ],
GROUP_TOP_LEFT() => [ 1, 0, 1, 0, ['gt','gl'] ],
};
my $border_name = [ 'top', 'bottom', 'left', 'right' ];
sub _css
{
my ($c, $id, $group, $border) = @_;
my $css = '';
for my $type (0 .. 5)
{
my $b = $border_styles->{$type};
# If border eq 'none', this would needlessly repeat the "border: none"
# from the general group class.
next if $border eq 'none';
my $cl = '.' . $b->[4]->[0]; # $cl .= "-$group" unless $group eq '';
$css .= "table.graph$id $cl {";
if ($type == GROUP_INNER)
{
$css .= " border: none;"; # shorter CSS
}
elsif ($type == GROUP_ALL)
{
$css .= " border-style: $border;"; # shorter CSS
}
else
{
for (my $i = 0; $i < 4; $i++)
{
$css .= ' border-' . $border_name->[$i] . "-style: $border;" if $b->[$i];
}
}
$css .= "}\n";
}
$css;
}
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = 'group';
$self->{cell_class} = ' gi';
$self->{name} = '';
$self->{'x'} = 0;
$self->{'y'} = 0;
# XXX TODO check arguments
foreach my $k (sort keys %$args)
{
$self->{$k} = $args->{$k};
}
if (defined $self->{group})
{
# register ourselves at this group
$self->{group}->_add_cell ($self);
# XXX CHECK also implement sub_class()
$self->{class} = $self->{group}->{class};
$self->{class} = 'group' unless defined $self->{class};
}
$self;
}
sub _set_type
{
# set the proper type of this cell based on the sourrounding cells
my ($self, $cells) = @_;
# +------+--------+-------+
# | LT TOP RU |
# + + + +
# | LEFT INNER Right |
# + + + +
# | LB BOTTOM RB |
# +------+--------+-------+
my @coord = (
[ 0, -1, ' gt' ],
[ +1, 0, ' gr' ],
[ 0, +1, ' gb' ],
[ -1, 0, ' gl' ],
);
my ($sx,$sy) = ($self->{x},$self->{y});
my $class = '';
my $gr = $self->{group};
foreach my $co (@coord)
{
my ($x,$y,$c) = @$co; $x += $sx; $y += $sy;
my $cell = $cells->{"$x,$y"};
# belongs to the same group?
my $go = 0; $go = $cell->group() if UNIVERSAL::can($cell, 'group');
$class .= $c unless defined $go && $gr == $go;
}
$class = ' ga' if $class eq ' gt gr gb gl';
$self->{cell_class} = $class;
$self;
}
sub _set_label
{
my $self = shift;
$self->{has_label} = 1;
$self->{name} = $self->{group}->label();
}
sub shape
{
'rect';
}
sub attribute
{
my ($self, $name) = @_;
# print STDERR "called attribute($name)\n";
# return $self->{group}->attribute($name);
my $group = $self->{group};
return $group->{att}->{$name} if exists $group->{att}->{$name};
$group->{cache} = {} unless exists $group->{cache};
$group->{cache}->{att} = {} unless exists $group->{cache}->{att};
my $cache = $group->{cache}->{att};
return $cache->{$name} if exists $cache->{$name};
$cache->{$name} = $group->attribute($name);
}
use constant isa_cell => 1;
#############################################################################
# conversion to ASCII or HTML
sub as_ascii
{
my ($self, $x,$y) = @_;
my $fb = $self->_framebuffer($self->{w}, $self->{h});
my $border_style = $self->attribute('borderstyle');
my $EM = 14;
# use $self here and not $self->{group} to engage attribute cache:
my $border_width = Graph::Easy::_border_width_in_pixels($self,$EM);
# convert overly broad borders to the correct style
$border_style = 'bold' if $border_width > 2;
$border_style = 'broad' if $border_width > $EM * 0.2 && $border_width < $EM * 0.75;
$border_style = 'wide' if $border_width >= $EM * 0.75;
if ($border_style ne 'none')
{
#########################################################################
# draw our border into the framebuffer
my $c = $self->{cell_class};
my $b_top = $border_style;
my $b_left = $border_style;
my $b_right = $border_style;
my $b_bottom = $border_style;
if ($c !~ 'ga')
{
$b_top = 'none' unless $c =~ /gt/;
$b_left = 'none' unless $c =~ /gl/;
$b_right = 'none' unless $c =~ /gr/;
$b_bottom = 'none' unless $c =~ /gb/;
}
$self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top, $x, $y);
}
if ($self->{has_label})
{
# include our label
my $align = $self->attribute('align');
# the default label cell as a top border, but no left/right border
my $ys = 0.5;
$ys = 0 if $border_style eq 'none';
my $h = $self->{h} - 1; $h ++ if $border_style eq 'none';
$self->_printfb_aligned ($fb, 0, $ys, $self->{w}, $h,
$self->_aligned_label($align), 'middle');
}
join ("\n", @$fb);
}
sub class
{
my $self = shift;
$self->{class} . $self->{cell_class};
}
#############################################################################
# for rendering this cell as ASCII/Boxart, we need to correct our width based
# on whether we have a border or not. But this is only known after parsing is
# complete.
sub _correct_size
{
my ($self,$format) = @_;
if (!defined $self->{w})
{
my $border = $self->attribute('borderstyle');
$self->{w} = 0;
$self->{h} = 0;
# label needs space
$self->{h} = 1 if $self->{has_label};
if ($border ne 'none')
{
# class "gt", "gb", "gr" or "gr" will be compressed away
# (e.g. only edge cells will be existent)
if ($self->{has_label} || ($self->{cell_class} =~ /g[rltb] /))
{
$self->{w} = 2;
$self->{h} = 2;
}
elsif ($self->{cell_class} =~ /^ g[rl]\z/)
{
$self->{w} = 2;
}
elsif ($self->{cell_class} =~ /^ g[bt]\z/)
{
$self->{h} = 2;
}
}
}
if ($self->{has_label})
{
my ($w,$h) = $self->dimensions();
$self->{h} += $h;
$self->{w} += $w;
}
}
1;
__END__
=head1 NAME
Graph::Easy::Group::Cell - A cell in a group
=head1 SYNOPSIS
use Graph::Easy;
my $ssl = Graph::Easy::Edge->new( );
$ssl->set_attributes(
label => 'encrypted connection',
style => '-->',
color => 'red',
);
$graph = Graph::Easy->new();
$graph->add_edge('source', 'destination', $ssl);
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Group::Cell> represents a cell of a group.
Group cells can have a background and, if they are on the outside, a border.
There should be no need to use this package directly.
=head1 METHODS
=head2 error()
$last_error = $group->error();
$group->error($error); # set new messages
$group->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $cell->as_ascii();
Returns the cell as a little ascii representation.
=head2 as_html()
my $html = $cell->as_html($tag,$id);
Returns the cell as HTML code.
=head2 label()
my $label = $cell->label();
Returns the name (also known as 'label') of the cell.
=head2 class()
my $class = $cell->class();
Returns the classname(s) of this cell, like:
group_cities gr gb
for a cell with a bottom (gb) and right (gr) border in the class C<cities>.
=head1 EXPORT
None.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

1071
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout.pm Normal file
View File

File diff suppressed because it is too large Load Diff

570
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Chain.pm Normal file
View File

@@ -0,0 +1,570 @@
#############################################################################
# One chain of nodes in a Graph::Easy - used internally for layouts.
#
# (c) by Tels 2004-2006. Part of Graph::Easy
#############################################################################
package Graph::Easy::Layout::Chain;
use Graph::Easy::Base;
$VERSION = '0.76';
@ISA = qw/Graph::Easy::Base/;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
use constant {
_ACTION_NODE => 0, # place node somewhere
_ACTION_TRACE => 1, # trace path from src to dest
_ACTION_CHAIN => 2, # place node in chain (with parent)
_ACTION_EDGES => 3, # trace all edges (shortes connect. first)
};
#############################################################################
sub _init
{
# Generic init routine, to be overriden in subclasses.
my ($self,$args) = @_;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(start|graph)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to __PACKAGE__->new()");
}
$self->{$k} = $args->{$k};
}
$self->{end} = $self->{start};
# store chain at node (to lookup node => chain info)
$self->{start}->{_chain} = $self;
$self->{start}->{_next} = undef;
$self->{len} = 1;
$self;
}
sub start
{
# return first node in the chain
my $self = shift;
$self->{start};
}
sub end
{
# return last node in the chain
my $self = shift;
$self->{end};
}
sub add_node
{
# add a node at the end of the chain
my ($self, $node) = @_;
# store at end
$self->{end}->{_next} = $node;
$self->{end} = $node;
# store chain at node (to lookup node => chain info)
$node->{_chain} = $self;
$node->{_next} = undef;
$self->{len} ++;
$self;
}
sub length
{
# Return the length of the chain in nodes. Takes optional
# node from where to calculate length.
my ($self, $node) = @_;
return $self->{len} unless defined $node;
my $len = 0;
while (defined $node)
{
$len++; $node = $node->{_next};
}
$len;
}
sub nodes
{
# return all the nodes in the chain as a list, in order.
my $self = shift;
my @nodes = ();
my $n = $self->{start};
while (defined $n)
{
push @nodes, $n;
$n = $n->{_next};
}
@nodes;
}
sub layout
{
# Return an action stack containing the nec. actions to
# lay out the nodes in the chain, plus any connections between
# them.
my ($self, $edge) = @_;
# prevent doing it twice
return [] if $self->{_done}; $self->{_done} = 1;
my @TODO = ();
my $g = $self->{graph};
# first, layout all the nodes in the chain:
# start with first node
my $pre = $self->{start}; my $n = $pre->{_next};
if (exists $pre->{_todo})
{
# edges with a flow attribute must be handled differently
# XXX TODO: the test for attribute('flow') might be wrong (raw_attribute()?)
if ($edge && ($edge->{to} == $pre) && ($edge->attribute('flow') || $edge->has_ports()))
{
push @TODO, $g->_action( _ACTION_CHAIN, $pre, 0, $edge->{from}, $edge);
}
else
{
push @TODO, $g->_action( _ACTION_NODE, $pre, 0, $edge );
}
}
print STDERR "# Stack after first:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
while (defined $n)
{
if (exists $n->{_todo})
{
# CHAIN means if $n isn't placed yet, it will be done with
# $pre as parent:
# in case there are multiple edges to the target node, use the first
# one to determine the flow:
my @edges = $g->edge($pre,$n);
push @TODO, $g->_action( _ACTION_CHAIN, $n, 0, $pre, $edges[0] );
}
$pre = $n;
$n = $n->{_next};
}
print STDERR "# Stack after chaining:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# link from each node to the next
$pre = $self->{start}; $n = $pre->{_next};
while (defined $n)
{
# first do edges going from P to N
#for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$pre->{edges}})
for my $e (ord_values ( $pre->{edges}))
{
# skip selfloops and backward links, these will be done later
next if $e->{to} != $n;
next unless exists $e->{_todo};
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
# # skip edges with a flow
# next if exists $e->{att}->{start} || exist $e->{att}->{end};
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
} continue { $pre = $n; $n = $n->{_next}; }
print STDERR "# Stack after chain-linking:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# Do all other links inside the chain (backwards, going forward more than
# one node etc)
$n = $self->{start};
while (defined $n)
{
my @edges;
my @count;
print STDERR "# inter-chain link from $n->{name}\n" if $g->{debug};
# gather all edges starting at $n, but do the ones with a flow first
# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
for my $e (ord_values ( $n->{edges}))
{
# skip selfloops, these will be done later
next if $e->{to} == $n;
next if !ref($e->{to}->{_chain});
next if !ref($e->{from}->{_chain});
next if $e->has_ports();
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
print STDERR "# inter-chain link from $n->{name} to $e->{to}->{name}\n" if $g->{debug};
# leaving the chain?
next if $e->{to}->{_chain} != $self;
# print STDERR "# trying for $n->{name}:\t $e->{from}->{name} to $e->{to}->{name}\n";
next unless exists $e->{_todo};
# calculate for this edge, how far it goes
my $count = 0;
my $curr = $n;
while (defined $curr && $curr != $e->{to})
{
$curr = $curr->{_next}; $count ++;
}
if (!defined $curr)
{
# edge goes backward
# start at $to
$curr = $e->{to};
$count = 0;
while (defined $curr && $curr != $e->{from})
{
$curr = $curr->{_next}; $count ++;
}
$count = 100000 if !defined $curr; # should not happen
}
push @edges, [ $count, $e ];
push @count, [ $count, $e->{from}->{name}, $e->{to}->{name} ];
}
# use Data::Dumper; print STDERR "count\n", Dumper(@count);
# do edges, shortest first
for my $e (sort { $a->[0] <=> $b->[0] } @edges)
{
push @TODO, [ _ACTION_TRACE, $e->[1] ];
delete $e->[1]->{_todo};
}
$n = $n->{_next};
}
# also do all selfloops on $n
$n = $self->{start};
while (defined $n)
{
# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
for my $e (ord_values $n->{edges})
{
next unless exists $e->{_todo};
# print STDERR "# $e->{from}->{name} to $e->{to}->{name} on $n->{name}\n";
# print STDERR "# ne $e->{to} $n $e->{id}\n"
# if $e->{from} != $n || $e->{to} != $n; # no selfloop?
next if $e->{from} != $n || $e->{to} != $n; # no selfloop?
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
$n = $n->{_next};
}
print STDERR "# Stack after self-loops:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# XXX TODO
# now we should do any links that start or end at this chain, recursively
$n = $self->{start};
while (defined $n)
{
# all chains that start at this node
for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
{
my $to = $e->{to};
# skip links to groups
next if $to->isa('Graph::Easy::Group');
# print STDERR "# chain-tracking to: $to->{name} $to->{_chain}\n";
next unless exists $to->{_chain} && ref($to->{_chain}) =~ /Chain/;
my $chain = $to->{_chain};
next if $chain->{_done};
# print STDERR "# chain-tracking to: $to->{name}\n";
# pass the edge along, in case it has a flow
# my @pass = ();
# push @pass, $e if $chain->{_first} && $e->{to} == $chain->{_first};
push @TODO, @{ $chain->layout($e) } unless $chain->{_done};
# link the edges to $to
next unless exists $e->{_todo}; # was already done above?
# next if $e->has_ports();
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
$n = $n->{_next};
}
\@TODO;
}
sub dump
{
# dump the chain to STDERR
my ($self, $indent) = @_;
$indent = '' unless defined $indent;
print STDERR "#$indent chain id $self->{id} (len $self->{len}):\n";
print STDERR "#$indent is empty\n" and return if $self->{len} == 0;
my $n = $self->{start};
while (defined $n)
{
print STDERR "#$indent $n->{name} (chain id: $n->{_chain}->{id})\n";
$n = $n->{_next};
}
$self;
}
sub merge
{
# take another chain, and merge it into ourselves. If $where is defined,
# absorb only the nodes from $where onwards (instead of all of them).
my ($self, $other, $where) = @_;
my $g = $self->{graph};
print STDERR "# panik: ", join(" \n",caller()),"\n" if !defined $other;
print STDERR
"# Merging chain $other->{id} (len $other->{len}) into $self->{id} (len $self->{len})\n"
if $g->{debug};
print STDERR
"# Merging from $where->{name} onwards\n"
if $g->{debug} && ref($where);
# cannot merge myself into myself (without allocating infinitely memory)
return if $self == $other;
# start at start as default
$where = undef unless ref($where) && exists $where->{_chain} && $where->{_chain} == $other;
$where = $other->{start} unless defined $where;
# make all nodes from chain #1 belong to it (to detect loops)
my $n = $self->{start};
while (defined $n)
{
$n->{_chain} = $self;
$n = $n->{_next};
}
print STDERR "# changed nodes\n" if $g->{debug};
$self->dump() if $g->{debug};
# terminate at $where
$self->{end}->{_next} = $where;
$self->{end} = $other->{end};
# start at joiner
$n = $where;
while (ref($n))
{
$n->{_chain} = $self;
my $pre = $n;
$n = $n->{_next};
# sleep(1);
# print "# at $n->{name} $n->{_chain}\n" if ref($n);
if (ref($n) && defined $n->{_chain} && $n->{_chain} == $self) # already points into ourself?
{
# sleep(1);
# print "# pre $pre->{name} $pre->{_chain}\n";
$pre->{_next} = undef; # terminate
$self->{end} = $pre;
last;
}
}
# could speed this up
$self->{len} = 0; $n = $self->{start};
while (defined $n)
{
$self->{len}++; $n = $n->{_next};
}
# print "done merging, dumping result:\n";
# $self->dump(); sleep(10);
if (defined $other->{start} && $where == $other->{start})
{
# we absorbed the other chain completely, so drop it
$other->{end} = undef;
$other->{start} = undef;
$other->{len} = 0;
# caller is responsible for cleaning it up
}
print STDERR "# after merging\n" if $g->{debug};
$self->dump() if $g->{debug};
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Chain - Chain of nodes for layouter
=head1 SYNOPSIS
# used internally, do not use directly
use Graph::Easy;
use Graph::Easy::Layout::Chain;
my $graph = Graph::Easy->new( );
my ($node, $node2) = $graph->add_edge( 'A', 'B' );
my $chain = Graph::Easy::Layout::Chain->new(
start => $node,
graph => $graph, );
$chain->add_node( $node2 );
=head1 DESCRIPTION
A C<Graph::Easy::Layout::Chain> object represents a chain of nodes
for the layouter.
=head1 METHODS
=head2 new()
my $chain = Graph::Easy::Layout::Chain->new( start => $node );
Create a new chain and set its starting node to C<$node>.
=head2 length()
my $len = $chain->length();
Return the length of the chain, in nodes.
my $len = $chain->length( $node );
Given an optional C<$node> as argument, returns the length
from that node onwards. For the chain with the three nodes
A, B and C would return 3, 2, and 1 for A, B and C, respectively.
Returns 0 if the passed node is not part of this chain.
=head2 nodes()
my @nodes = $chain->nodes();
Return all the node objects in the chain as list, in order.
=head2 add_node()
$chain->add_node( $node );
Add C<$node> to the end of the chain.
=head2 start()
my $node = $chain->start();
Return first node in the chain.
=head2 end()
my $node = $chain->end();
Return last node in the chain.
=head2 layout()
my $todo = $chain->layout();
Return an action stack as array ref, containing the nec. actions to
layout the chain (nodes, plus interlinks in the chain).
Will recursively traverse all chains linked to this chain.
=head2 merge()
my $chain->merge ( $other_chain );
my $chain->merge ( $other_chain, $where );
Merge the other chain into ourselves, adding its nodes at our end.
The other chain is emptied and must be deleted by the caller.
If C<$where> is defined and a member of C<$other_chain>, absorb only the
nodes from C<$where> onwards, instead of all of them.
=head2 error()
$last_error = $node->error();
$node->error($error); # set new messages
$node->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 dump()
$chain->dump();
Dump the chain to STDERR, to aid debugging.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>, L<Graph::Easy::Layout>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

251
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Force.pm Normal file
View File

@@ -0,0 +1,251 @@
#############################################################################
# Force-based layouter for Graph::Easy.
#
# (c) by Tels 2004-2007.
#############################################################################
package Graph::Easy::Layout::Force;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _layout_force
{
# Calculate for each node the force on it, then move them accordingly.
# When things have settled, stop.
my ($self) = @_;
# For each node, calculate the force acting on it, separated into two
# components along the X and Y axis:
# XXX TODO: replace with all contained nodes + groups
my @nodes = $self->nodes();
return if @nodes == 0;
my $root = $self->root_node();
if (!defined $root)
{
# find a suitable root node
$root = $nodes[0];
}
# this node never moves
$root->{_pinned} = undef;
$root->{x} = 0;
$root->{y} = 0;
# get the "gravity" force
my $gx = 0; my $gy = 0;
my $flow = $self->flow();
if ($flow == 0)
{
$gx = 1;
}
elsif ($flow == 90)
{
$gy = -1;
}
elsif ($flow == 270)
{
$gy = 1;
}
else # ($flow == 180)
{
$gx = -1;
}
my @particles;
# set initial positions
for my $n (@nodes)
{
# the net force on this node is the gravity
$n->{_x_force} = $gx;
$n->{_y_force} = $gy;
if ($root == $n || defined $n->{origin})
{
# nodes that are relative to another are "pinned"
$n->{_pinned} = undef;
}
else
{
$n->{x} = rand(100);
$n->{y} = rand(100);
push @particles, $n;
}
}
my $energy = 1;
while ($energy > 0.1)
{
$energy = 0;
for my $n (@particles)
{
# reset forces on this node
$n->{_x_force} = 0;
$n->{_y_force} = 0;
# Add forces of all other nodes. We need to include pinned nodes here,
# too, since a moving node might get near a pinned one and get repelled.
for my $n2 (@nodes)
{
next if $n2 == $n; # don't repel yourself
my $dx = ($n->{x} - $n2->{x});
my $dy = ($n->{y} - $n2->{y});
my $r = $dx * $dx + $dy * $dy;
$r = 0.01 if $r < 0.01; # too small?
if ($r < 4)
{
# not too big
$n->{_x_force} += 1 / $dx * $dx;
$n->{_y_force} += 1 / $dy * $dy;
my $dx2 = 1 / $dx * $dx;
my $dy2 = 1 / $dy * $dy;
print STDERR "# Force between $n->{name} and $n2->{name}: fx $dx2, fy $dy2\n";
}
}
# for all edges connected at this node
for my $e (ord_values ( $n->{edges} ))
{
# exclude self-loops
next if $e->{from} == $n && $e->{to} == $n;
# get the other end-point of this edge
my $n2 = $e->{from}; $n2 = $e->{to} if $n2 == $n;
# XXX TODO
# we should "connect" the edges to the appropriate port so that
# they excert an off-center force
my $dx = -($n->{x} - $n2->{x}) / 2;
my $dy = -($n->{y} - $n2->{y}) / 2;
print STDERR "# Spring force between $n->{name} and $n2->{name}: fx $dx, fy $dy\n";
$n->{_x_force} += $dx;
$n->{_y_force} += $dy;
}
print STDERR "# $n->{name}: Summed force: fx $n->{_x_force}, fy $n->{_y_force}\n";
# for grid-like layouts, add a small force drawing this node to the gridpoint
# 0.7 => 1 - 0.7 => 0.3
# 1.2 => 1 - 1.2 => -0.2
my $dx = int($n->{x} + 0.5) - $n->{x};
$n->{_x_force} += $dx;
my $dy = int($n->{y} + 0.5) - $n->{y};
$n->{_y_force} += $dy;
print STDERR "# $n->{name}: Final force: fx $n->{_x_force}, fy $n->{_y_force}\n";
$energy += $n->{_x_force} * $n->{_x_force} + $n->{_x_force} * $n->{_y_force};
print STDERR "# Net energy: $energy\n";
}
# after having calculated all forces, move the nodes
for my $n (@particles)
{
my $dx = $n->{_x_force};
$dx = 5 if $dx > 5; # limit it
$n->{x} += $dx;
my $dy = $n->{_y_force};
$dy = 5 if $dy > 5; # limit it
$n->{y} += $dy;
print STDERR "# $n->{name}: Position $n->{x}, $n->{y}\n";
}
sleep(1); print STDERR "\n";
}
for my $n (@nodes)
{
delete $n->{_x_force};
delete $n->{_y_force};
}
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Force - Force-based layouter for Graph::Easy
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
$graph->add_edge ('Bonn', 'Berlin');
$graph->add_edge ('Bonn', 'Ulm');
$graph->add_edge ('Ulm', 'Berlin');
$graph->layout( type => 'force' );
print $graph->as_ascii( );
# prints:
# +------------------------+
# | v
# +------+ +-----+ +--------+
# | Bonn | --> | Ulm | --> | Berlin |
# +------+ +-----+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Force> contains routines that calculate a
force-based layout for a graph.
Nodes repell each other, while edges connecting them draw them together.
The layouter calculates the forces on each node, then moves them around
according to these forces until things have settled down.
Used automatically by Graph::Easy.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS
This module injects the following methods into Graph::Easy:
=head2 _layout_force()
Calculates the node position with a force-based method.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

348
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Grid.pm Normal file
View File

@@ -0,0 +1,348 @@
#############################################################################
# Grid-management and layout preparation.
#
# (c) by Tels 2004-2006.
#############################################################################
package Graph::Easy::Layout::Grid;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _balance_sizes
{
# Given a list of column/row sizes and a minimum size that their sum must
# be, will grow individual sizes until the constraint (sum) is met.
my ($self, $sizes, $need) = @_;
# XXX TODO: we can abort the loop and distribute the remaining nec. size
# once all elements in $sizes are equal.
return if $need < 1;
# if there is only one element, return it immediately
if (@$sizes == 1)
{
$sizes->[0] = $need if $sizes->[0] < $need;
return;
}
# endless loop until constraint is met
while (1)
{
# find the smallest size, and also compute their sum
my $sum = 0; my $i = 0;
my $sm = $need + 1; # start with an arbitrary size
my $sm_i = 0; # if none is != 0, then use the first
for my $s (@$sizes)
{
$sum += $s;
next if $s == 0;
if ($s < $sm)
{
$sm = $s; $sm_i = $i;
}
$i++;
}
# their sum is already equal or bigger than what we need?
last if $sum >= $need;
# increase the smallest size by one, then try again
$sizes->[$sm_i]++;
}
# use Data::Dumper; print STDERR "# " . Dumper($sizes),"\n";
undef;
}
sub _prepare_layout
{
# this method is used by as_ascii() and as_svg() to find out the
# sizes and placement of the different cells (edges, nodes etc).
my ($self,$format) = @_;
# Find out for each row and column how big they are:
# +--------+-----+------+
# | Berlin | --> | Bonn |
# +--------+-----+------+
# results in:
# w, h, x, y
# 0,0 => 10, 3, 0, 0
# 1,0 => 7, 3, 10, 0
# 2,0 => 8, 3, 16, 0
# Technically, we also need to "compress" away non-existent columns/rows.
# We achieve that by simply rendering them with size 0, so they become
# practically invisible.
my $cells = $self->{cells};
my $rows = {};
my $cols = {};
# the last column/row (highest X,Y pair)
my $mx = -1000000; my $my = -1000000;
# We need to do this twice, once for single-cell objects, and again for
# objects covering multiple cells. The single-cell objects can be solved
# first:
# find all x and y occurrences to sort them by row/columns
for my $cell (ord_values $cells)
{
my ($x,$y) = ($cell->{x}, $cell->{y});
{
no strict 'refs';
my $method = '_correct_size_' . $format;
$method = '_correct_size' unless $cell->can($method);
$cell->$method();
}
my $w = $cell->{w} || 0;
my $h = $cell->{h} || 0;
# Set the minimum cell size only for single-celled objects:
if ( (($cell->{cx}||1) + ($cell->{cy}||1)) == 2)
{
# record maximum size for that col/row
$rows->{$y} = $h if $h >= ($rows->{$y} || 0);
$cols->{$x} = $w if $w >= ($cols->{$x} || 0);
}
# Find highest X,Y pair. Always use x,y, and not x+cx,y+cy, because
# a multi-celled object "sticking" out will not count unless there
# is another object in the same row/column.
$mx = $x if $x > $mx;
$my = $y if $y > $my;
}
# insert a dummy row/column with size=0 as last
$rows->{$my+1} = 0;
$cols->{$mx+1} = 0;
# do the last step again, but for multi-celled objects
for my $cell (ord_values $cells)
{
my ($x,$y) = ($cell->{x}, $cell->{y});
my $w = $cell->{w} || 0;
my $h = $cell->{h} || 0;
# Set the minimum cell size only for multi-celled objects:
if ( (($cell->{cx} || 1) + ($cell->{cy}||1)) > 2)
{
$cell->{cx} ||= 1;
$cell->{cy} ||= 1;
# do this twice, for X and Y:
# print STDERR "\n# ", $cell->{name} || $cell->{id}, " cx=$cell->{cx} cy=$cell->{cy} $cell->{w},$cell->{h}:\n";
# create an array with the current sizes for the affacted rows/columns
my @sizes;
# print STDERR "# $cell->{cx} $cell->{cy} at cx:\n";
# XXX TODO: no need to do this for empty/zero cols
for (my $i = 0; $i < $cell->{cx}; $i++)
{
push @sizes, $cols->{$i+$x} || 0;
}
$self->_balance_sizes(\@sizes, $cell->{w});
# store the result back
for (my $i = 0; $i < $cell->{cx}; $i++)
{
# print STDERR "# store back $sizes[$i] to col ", $i+$x,"\n";
$cols->{$i+$x} = $sizes[$i];
}
@sizes = ();
# print STDERR "# $cell->{cx} $cell->{cy} at cy:\n";
# XXX TODO: no need to do this for empty/zero cols
for (my $i = 0; $i < $cell->{cy}; $i++)
{
push @sizes, $rows->{$i+$y} || 0;
}
$self->_balance_sizes(\@sizes, $cell->{h});
# store the result back
for (my $i = 0; $i < $cell->{cy}; $i++)
{
# print STDERR "# store back $sizes[$i] to row ", $i+$y,"\n";
$rows->{$i+$y} = $sizes[$i];
}
}
}
print STDERR "# Calculating absolute positions for rows/columns\n" if $self->{debug};
# Now run through all rows/columns and get their absolute pos by taking all
# previous ones into account.
my $pos = 0;
for my $y (sort { $a <=> $b } keys %$rows)
{
my $s = $rows->{$y};
$rows->{$y} = $pos; # first is 0, second is $rows[1] etc
$pos += $s;
}
$pos = 0;
for my $x (sort { $a <=> $b } keys %$cols)
{
my $s = $cols->{$x};
$cols->{$x} = $pos;
$pos += $s;
}
# find out max. dimensions for framebuffer
print STDERR "# Finding max. dimensions for framebuffer\n" if $self->{debug};
my $max_y = 0; my $max_x = 0;
for my $v (ord_values $cells)
{
# Skip multi-celled nodes for later.
next if ($v->{cx}||1) + ($v->{cy}||1) != 2;
# X and Y are col/row, so translate them to real pos
my $x = $cols->{ $v->{x} };
my $y = $rows->{ $v->{y} };
# Also set correct the width/height of each cell to be the maximum
# width/height of that row/column and store the previous size in 'minw'
# and 'minh', respectively.
$v->{minw} = $v->{w};
$v->{minh} = $v->{h};
# find next col/row
my $nx = $v->{x} + 1;
my $next_col = $cols->{ $nx };
my $ny = $v->{y} + 1;
my $next_row = $rows->{ $ny };
$next_col = $cols->{ ++$nx } while (!defined $next_col);
$next_row = $rows->{ ++$ny } while (!defined $next_row);
$v->{w} = $next_col - $x;
$v->{h} = $next_row - $y;
my $m = $y + $v->{h} - 1;
$max_y = $m if $m > $max_y;
$m = $x + $v->{w} - 1;
$max_x = $m if $m > $max_x;
}
# repeat the previous step, now for multi-celled objects
foreach my $v (ord_values ( $self->{cells} ))
{
next unless defined $v->{x} && (($v->{cx}||1) + ($v->{cy}||1) > 2);
# X and Y are col/row, so translate them to real pos
my $x = $cols->{ $v->{x} };
my $y = $rows->{ $v->{y} };
$v->{minw} = $v->{w};
$v->{minh} = $v->{h};
# find next col/row
my $nx = $v->{x} + ($v->{cx} || 1);
my $next_col = $cols->{ $nx };
my $ny = $v->{y} + ($v->{cy} || 1);
my $next_row = $rows->{ $ny };
$next_col = $cols->{ ++$nx } while (!defined $next_col);
$next_row = $rows->{ ++$ny } while (!defined $next_row);
$v->{w} = $next_col - $x;
$v->{h} = $next_row - $y;
my $m = $y + $v->{h} - 1;
$max_y = $m if $m > $max_y;
$m = $x + $v->{w} - 1;
$max_x = $m if $m > $max_x;
}
# return what we found out:
($rows,$cols,$max_x,$max_y);
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Grid - Grid management and size calculation
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Grid> contains routines that calculate cell sizes
on the grid, which is necessary for ASCII, boxart and SVG output.
Used automatically by Graph::Easy.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS
This module injects the following methods into Graph::Easy:
=head2 _prepare_layout()
my ($rows,$cols,$max_x,$max_y, \@V) = $graph->_prepare_layout();
Returns two hashes (C<$rows> and C<$cols>), containing the columns and rows
of the layout with their nec. sizes (in chars) plus the maximum
framebuffer size nec. for this layout. Also returns reference of
a list of all cells to be rendered.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

916
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Path.pm Normal file
View File

@@ -0,0 +1,916 @@
#############################################################################
# Path and cell management for Graph::Easy.
#
#############################################################################
package Graph::Easy::Layout::Path;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy::Node;
use strict;
use warnings;
use Graph::Easy::Edge::Cell qw/
EDGE_END_E EDGE_END_N EDGE_END_S EDGE_END_W
/;
sub _shuffle_dir
{
# take a list with four entries and shuffle them around according to $dir
my ($self, $e, $dir) = @_;
# $dir: 0 => north, 90 => east, 180 => south, 270 => west
$dir = 90 unless defined $dir; # default is east
return [ @$e ] if $dir == 90; # default is no shuffling
my @shuffle = (0,1,2,3); # the default
@shuffle = (1,2,0,3) if $dir == 180; # south
@shuffle = (2,3,1,0) if $dir == 270; # west
@shuffle = (3,0,2,1) if $dir == 0; # north
[
$e->[ $shuffle[0] ],
$e->[ $shuffle[1] ],
$e->[ $shuffle[2] ],
$e->[ $shuffle[3] ],
];
}
sub _shift
{
# get a flow shifted by X° to $dir
my ($self, $turn) = @_;
my $dir = $self->flow();
$dir += $turn;
$dir += 360 if $dir < 0;
$dir -= 360 if $dir > 360;
$dir;
}
sub _near_places
{
# Take a node and return a list of possible placements around it and
# prune out already occupied cells. $d is the distance from the node
# border and defaults to two (for placements). Set it to one for
# adjacent cells.
# If defined, $type contains four flags for each direction. If undef,
# two entries (x,y) will be returned for each pos, instead of (x,y,type).
# If $loose is true, no checking whether the returned fields are free
# is done.
my ($n, $cells, $d, $type, $loose, $dir) = @_;
my $cx = $n->{cx} || 1;
my $cy = $n->{cy} || 1;
$d = 2 unless defined $d; # default is distance = 2
my $flags = $type;
if (ref($flags) ne 'ARRAY')
{
$flags = [
EDGE_END_W,
EDGE_END_N,
EDGE_END_E,
EDGE_END_S,
];
}
$dir = $n->flow() unless defined $dir;
my $index = $n->_shuffle_dir( [ 0,3,6,9], $dir);
my @places = ();
# single-celled node
if ($cx + $cy == 2)
{
my @tries = (
$n->{x} + $d, $n->{y}, $flags->[0], # right
$n->{x}, $n->{y} + $d, $flags->[1], # down
$n->{x} - $d, $n->{y}, $flags->[2], # left
$n->{x}, $n->{y} - $d, $flags->[3], # up
);
for my $i (0..3)
{
my $idx = $index->[$i];
my ($x,$y,$t) = ($tries[$idx], $tries[$idx+1], $tries[$idx+2]);
# print STDERR "# Considering place $x, $y \n";
# This quick check does not take node clusters or multi-celled nodes
# into account. These are handled in $node->_do_place() later.
next if !$loose && exists $cells->{"$x,$y"};
push @places, $x, $y;
push @places, $t if defined $type;
}
return @places;
}
# Handle a multi-celled node. For a 3x2 node:
# A B C
# J [00][10][20] D
# I [10][11][21] E
# H G F
# we have 10 (3 * 2 + 2 * 2) places to consider
my $nx = $n->{x};
my $ny = $n->{y};
my ($px,$py);
my $idx = 0;
my @results = ( [], [], [], [] );
$cy--; $cx--;
my $t = $flags->[$idx++];
# right
$px = $nx + $cx + $d;
for my $y (0 .. $cy)
{
$py = $y + $ny;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[0]}, $px, $py;
push @{$results[0]}, $t if defined $type;
}
# below
$py = $ny + $cy + $d;
$t = $flags->[$idx++];
for my $x (0 .. $cx)
{
$px = $x + $nx;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[1]}, $px, $py;
push @{$results[1]}, $t if defined $type;
}
# left
$px = $nx - $d;
$t = $flags->[$idx++];
for my $y (0 .. $cy)
{
$py = $y + $ny;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[2]}, $px, $py;
push @{$results[2]}, $t if defined $type;
}
# top
$py = $ny - $d;
$t = $flags->[$idx];
for my $x (0 .. $cx)
{
$px = $x + $nx;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[3]}, $px, $py;
push @{$results[3]}, $t if defined $type;
}
# accumulate the results in the requested, shuffled order
for my $i (0..3)
{
my $idx = $index->[$i] / 3;
push @places, @{$results[$idx]};
}
@places;
}
sub _allowed_places
{
# given a list of potential positions, and a list of allowed positions,
# return the valid ones (e.g. that are in both lists)
my ($self, $places, $allowed, $step) = @_;
print STDERR
"# calculating allowed places for $self->{name} from " . @$places .
" positions and " . scalar @$allowed . " allowed ones:\n"
if $self->{graph}->{debug};
$step ||= 2; # default: "x,y"
my @good;
my $i = 0;
while ($i < @$places)
{
my ($x,$y) = ($places->[$i], $places->[$i+1]);
my $allow = 0;
my $j = 0;
while ($j < @$allowed)
{
my ($m,$n) = ($allowed->[$j], $allowed->[$j+1]);
$allow++ and last if ($m == $x && $n == $y);
} continue { $j += 2; }
next unless $allow;
push @good, $places->[$i + $_ -1] for (1..$step);
} continue { $i += $step; }
print STDERR "# left with " . ((scalar @good) / $step) . " position(s)\n" if $self->{graph}->{debug};
@good;
}
sub _allow
{
# return a list of places, depending on the start/end attribute:
# "south" - any place south
# "south,0" - first place south
# "south,-1" - last place south
# XXX TODO:
# "south,0..2" - first three places south
# "south,0,1,-1" - first, second and last place south
my ($self, $dir, @pos) = @_;
# for relative direction, get the absolute flow from the node
if ($dir =~ /^(front|forward|back|left|right)\z/)
{
# get the flow at the node
$dir = $self->flow();
}
my $place = {
'south' => [ 0,0, 0,1, 'cx', 1,0 ],
'north' => [ 0,-1, 0,0, 'cx', 1,0 ],
'east' => [ 0,0, 1,0, 'cy', 0,1 ],
'west' => [ -1,0, 0,0, 'cy', 0,1 ] ,
180 => [ 0,0, 0,1, 'cx', 1,0 ],
0 => [ 0,-1, 0,0, 'cx', 1,0 ],
90 => [ 0,0, 1,0, 'cy', 0,1 ],
270 => [ -1,0, 0,0, 'cy', 0,1 ] ,
};
my $p = $place->{$dir};
return [] unless defined $p;
# start pos
my $x = $p->[0] + $self->{x} + $p->[2] * $self->{cx};
my $y = $p->[1] + $self->{y} + $p->[3] * $self->{cy};
my @allowed;
push @pos, '' if @pos == 0;
my $c = $p->[4];
if (@pos == 1 && $pos[0] eq '')
{
# allow all of them
for (1 .. $self->{$c})
{
push @allowed, $x, $y;
$x += $p->[5];
$y += $p->[6];
}
}
else
{
# allow only the given position
my $ps = $pos[0];
# limit to 0..$self->{cx}-1
$ps = $self->{$c} + $ps if $ps < 0;
$ps = 0 if $ps < 0;
$ps = $self->{$c} - 1 if $ps >= $self->{$c};
$x += $p->[5] * $ps;
$y += $p->[6] * $ps;
push @allowed, $x, $y;
}
\@allowed;
}
package Graph::Easy;
use strict;
use Graph::Easy::Node::Cell;
use Graph::Easy::Edge::Cell qw/
EDGE_HOR EDGE_VER EDGE_CROSS
EDGE_TYPE_MASK
EDGE_HOLE
/;
sub _clear_tries
{
# Take a list of potential positions for a node, and then remove the
# ones that are immediately near any other node.
# Returns a list of "good" positions. Afterwards $node->{x} is undef.
my ($self, $node, $cells, $tries) = @_;
my $src = 0; my @new;
print STDERR "# clearing ", scalar @$tries / 2, " tries for $node->{name}\n" if $self->{debug};
my $node_grandpa = $node->find_grandparent();
while ($src < scalar @$tries)
{
# check the current position
# temporary place node here
my $x = $tries->[$src];
my $y = $tries->[$src+1];
# print STDERR "# checking $x,$y\n" if $self->{debug};
$node->{x} = $x;
$node->{y} = $y;
my @near = $node->_near_places($cells, 1, undef, 1);
# push also the four corner cells to avoid placing nodes corner-to-corner
push @near, $x-1, $y-1, # upperleft corner
$x-1, $y+($node->{cy}||1), # lowerleft corner
$x+($node->{cx}||1), $y+($node->{cy}||1), # lowerright corner
$x+($node->{cx}||1), $y-1; # upperright corner
# check all near places to be free from nodes (except our children)
my $j = 0; my $g = 0;
while ($j < @near)
{
my $xy = $near[$j]. ',' . $near[$j+1];
# print STDERR "# checking near-place: $xy: " . ref($cells->{$xy}) . "\n" if $self->{debug};
my $cell = $cells->{$xy};
# skip, unless we are a children of node, or the cell is our children
next unless ref($cell) && $cell->isa('Graph::Easy::Node');
my $grandpa = $cell->find_grandparent();
# this cell is our children
# this cell is our grandpa
# has the same grandpa as node
next if $grandpa == $node || $cell == $node_grandpa || $grandpa == $node_grandpa;
$g++; last;
} continue { $j += 2; }
if ($g == 0)
{
push @new, $tries->[$src], $tries->[$src+1];
}
$src += 2;
}
$node->{x} = undef;
@new;
}
my $flow_shift = {
270 => [ 0, -1 ],
90 => [ 0, 1 ],
0 => [ 1, 0 ],
180 => [ -1, 0 ],
};
sub _placed_shared
{
# check whether one of the nodes from the list of shared was already placed
my ($self) = shift;
my $placed;
for my $n (@_)
{
$placed = [$n->{x}, $n->{y}] and last if defined $n->{x};
}
$placed;
}
use Graph::Easy::Util qw(first_kv);
sub _find_node_place
{
# Try to place a node (or node cluster). Return score (usually 0).
my ($self, $node, $try, $parent, $edge) = @_;
$try ||= 0;
print STDERR "# Finding place for $node->{name}, try #$try\n" if $self->{debug};
print STDERR "# Parent node is '$parent->{name}'\n" if $self->{debug} && ref $parent;
print STDERR "# called from ". join (" ", caller) . "\n" if $self->{debug};
# If the node has a user-set rank, see if we already placed another node in that
# row/column
if ($node->{rank} >= 0)
{
my $r = abs($node->{rank});
# print STDERR "# User-set rank for $node->{name} (rank $r)\n";
my $c = $self->{_rank_coord};
# use Data::Dumper; print STDERR "# rank_pos: \n", Dumper($self->{_rank_pos});
if (exists $self->{_rank_pos}->{ $r })
{
my $co = { x => 0, y => 0 };
$co->{$c} = $self->{_rank_pos}->{ $r };
while (1 < 3)
{
# print STDERR "# trying to force placement of '$node->{name}' at $co->{x} $co->{y}\n";
return 0 if $node->_do_place($co->{x},$co->{y},$self);
$co->{$c} += 2;
}
}
}
my $cells = $self->{cells};
# local $self->{debug} = 1;
my $min_dist = 2;
# minlen = 0 => min_dist = 2,
# minlen = 1 => min_dist = 2,
# minlen = 2 => min_dist = 3, etc
$min_dist = $edge->attribute('minlen') + 1 if ref($edge);
# if the node has outgoing edges (which might be shared)
if (!ref($edge))
{
(undef,$edge) = first_kv($node->{edges}) if keys %{$node->{edges}} > 0;
}
my $dir = undef; $dir = $edge->flow() if ref($edge);
my @tries;
# if (ref($parent) && defined $parent->{x})
if (keys %{$node->{edges}} > 0)
{
my $src_node = $parent; $src_node = $edge->{from} if ref($edge) && !ref($parent);
print STDERR "# from $src_node->{name} to $node->{name}: edge $edge dir $dir\n" if $self->{debug};
# if there are more than one edge to this node, and they share a start point,
# move the node at least 3 cells away to create space for the joints
my ($s_p, @ss_p);
($s_p, @ss_p) = $edge->port('start') if ref($edge);
my ($from,$to);
if (ref($edge))
{
$from = $edge->{from}; $to = $edge->{to};
}
my @shared_nodes;
@shared_nodes = $from->nodes_sharing_start($s_p,@ss_p) if defined $s_p && @ss_p > 0;
print STDERR "# Edge from '$src_node->{name}' shares an edge start with ", scalar @shared_nodes, " other nodes\n"
if $self->{debug};
if (@shared_nodes > 1)
{
$min_dist = 3 if $min_dist < 3; # make space
$min_dist++ if $edge->label() ne ''; # make more space for the label
# if we are the first shared node to be placed
my $placed = $self->_placed_shared(@shared_nodes);
if (defined $placed)
{
# we are not the first, so skip the placement below
# instead place on the same column/row as already placed node(s)
my ($bx, $by) = @$placed;
my $flow = $node->flow();
print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
if $self->{debug};
my $ofs = 2; # start with a distance of 2
my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
while (1)
{
my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
if $self->{debug};
next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
last if $node->_do_place($x,$y,$self);
}
continue {
$ofs += 2;
}
return 0; # found place already
} # end we-are-the-first-to-be-placed
}
# shared end point?
($s_p, @ss_p) = $edge->port('end') if ref($edge);
@shared_nodes = $to->nodes_sharing_end($s_p,@ss_p) if defined $s_p && @ss_p > 0;
print STDERR "# Edge from '$src_node->{name}' shares an edge end with ", scalar @shared_nodes, " other nodes\n"
if $self->{debug};
if (@shared_nodes > 1)
{
$min_dist = 3 if $min_dist < 3;
$min_dist++ if $edge->label() ne ''; # make more space for the label
# if the node to be placed is not in the list to be placed, it is the end-point
# see if we are the first shared node to be placed
my $placed = $self->_placed_shared(@shared_nodes);
# print STDERR "# "; for (@shared_nodes) { print $_->{name}, " "; } print "\n";
if ((grep( $_ == $node, @shared_nodes)) && defined $placed)
{
# we are not the first, so skip the placement below
# instead place on the same column/row as already placed node(s)
my ($bx, $by) = @$placed;
my $flow = $node->flow();
print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
if $self->{debug};
my $ofs = 2; # start with a distance of 2
my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
while (1)
{
my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
if $self->{debug};
next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
last if $node->_do_place($x,$y,$self);
}
continue {
$ofs += 2;
}
return 0; # found place already
} # end we-are-the-first-to-be-placed
}
}
if (ref($parent) && defined $parent->{x})
{
@tries = $parent->_near_places($cells, $min_dist, undef, 0, $dir);
print STDERR
"# Trying chained placement of $node->{name} with min distance $min_dist from parent $parent->{name}\n"
if $self->{debug};
# weed out positions that are unsuitable
@tries = $self->_clear_tries($node, $cells, \@tries);
splice (@tries,0,$try) if $try > 0; # remove the first N tries
print STDERR "# Left with " . scalar @tries . " tries for node $node->{name}\n" if $self->{debug};
while (@tries > 0)
{
my $x = shift @tries;
my $y = shift @tries;
print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
return 0 if $node->_do_place($x,$y,$self);
} # for all trial positions
}
print STDERR "# Trying to place $node->{name} at 0,0\n" if $try == 0 && $self->{debug};
# Try to place node at upper left corner (the very first node to be
# placed will usually end up there).
return 0 if $try == 0 && $node->_do_place(0,0,$self);
# try to place node near the predecessor(s)
my @pre_all = $node->predecessors();
print STDERR "# Predecessors of $node->{name} " . scalar @pre_all . "\n" if $self->{debug};
# find all already placed predecessors
my @pre;
for my $p (@pre_all)
{
push @pre, $p if defined $p->{x};
print STDERR "# Placed predecessors of $node->{name}: $p->{name} at $p->{x},$p->{y}\n" if $self->{debug} && defined $p->{x};
}
# sort predecessors on their rank (to try first the higher ranking ones on placement)
@pre = sort { $b->{rank} <=> $a->{rank} } @pre;
print STDERR "# Number of placed predecessors of $node->{name}: " . scalar @pre . "\n" if $self->{debug};
if (@pre <= 2 && @pre > 0)
{
if (@pre == 1)
{
# only one placed predecessor, so place $node near it
print STDERR "# placing $node->{name} near predecessor\n" if $self->{debug};
@tries = ( $pre[0]->_near_places($cells, $min_dist), $pre[0]->_near_places($cells,$min_dist+2) );
}
else
{
# two placed predecessors, so place at crossing point of both of them
# compute difference between the two nodes
my $dx = ($pre[0]->{x} - $pre[1]->{x});
my $dy = ($pre[0]->{y} - $pre[1]->{y});
# are both nodes NOT on a straight line?
if ($dx != 0 && $dy != 0)
{
# ok, so try to place at the crossing point
@tries = (
$pre[0]->{x}, $pre[1]->{y},
$pre[0]->{y}, $pre[1]->{x},
);
}
else
{
# two nodes on a line, try to place node in the middle
if ($dx == 0)
{
@tries = ( $pre[1]->{x}, $pre[1]->{y} + int($dy / 2) );
}
else
{
@tries = ( $pre[1]->{x} + int($dx / 2), $pre[1]->{y} );
}
}
# XXX TODO BUG: shouldn't we also try this if we have more than 2
# placed predecessors?
# In addition, we can also try to place the node around the
# different nodes:
foreach my $n (@pre)
{
push @tries, $n->_near_places($cells, $min_dist);
}
}
}
my @suc_all = $node->successors();
# find all already placed successors
my @suc;
for my $s (@suc_all)
{
push @suc, $s if defined $s->{x};
}
print STDERR "# Number of placed successors of $node->{name}: " . scalar @suc . "\n" if $self->{debug};
foreach my $s (@suc)
{
# for each successors (especially if there is only one), try to place near
push @tries, $s->_near_places($cells, $min_dist);
push @tries, $s->_near_places($cells, $min_dist + 2);
}
# weed out positions that are unsuitable
@tries = $self->_clear_tries($node, $cells, \@tries);
print STDERR "# Left with " . scalar @tries . " for node $node->{name}\n" if $self->{debug};
splice (@tries,0,$try) if $try > 0; # remove the first N tries
while (@tries > 0)
{
my $x = shift @tries;
my $y = shift @tries;
print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
return 0 if $node->_do_place($x,$y,$self);
} # for all trial positions
##############################################################################
# all simple possibilities exhausted, try a generic approach
print STDERR "# No more simple possibilities for node $node->{name}\n" if $self->{debug};
# XXX TODO:
# find out which sides of the node predecessor node(s) still have free
# ports/slots. With increasing distances, try to place the node around these.
# If no predecessors/incoming edges, try to place in column 0, otherwise
# considered the node's rank, too
my $col = 0; $col = $node->{rank} * 2 if @pre > 0;
$col = $pre[0]->{x} if @pre > 0;
# find the first free row
my $y = 0;
$y +=2 while (exists $cells->{"$col,$y"});
$y += 1 if exists $cells->{"$col," . ($y-1)}; # leave one cell spacing
# now try to place node (or node cluster)
while (1)
{
next if $self->_clear_tries($node, $cells, [ $col,$y ]) == 0;
last if $node->_do_place($col,$y,$self);
}
continue {
$y += 2;
}
$node->{x} = $col;
0; # success, score 0
}
sub _trace_path
{
# find a free way from $src to $dst (both need to be placed beforehand)
my ($self, $src, $dst, $edge) = @_;
print STDERR "# Finding path from '$src->{name}' to '$dst->{name}'\n" if $self->{debug};
print STDERR "# src: $src->{x}, $src->{y} dst: $dst->{x}, $dst->{y}\n" if $self->{debug};
my $coords = $self->_find_path ($src, $dst, $edge);
# found no path?
if (!defined $coords)
{
print STDERR "# Unable to find path from $src->{name} ($src->{x},$src->{y}) to $dst->{name} ($dst->{x},$dst->{y})\n" if $self->{debug};
return undef;
}
# path is empty, happens for sharing edges with only a joint
return 1 if scalar @$coords == 0;
# Create all cells from the returned list and score path (lower score: better)
my $i = 0;
my $score = 0;
while ($i < scalar @$coords)
{
my $type = $coords->[$i+2];
$self->_create_cell($edge,$coords->[$i],$coords->[$i+1],$type);
$score ++; # each element: one point
$type &= EDGE_TYPE_MASK; # mask flags
# edge bend or cross: one point extra
$score ++ if $type != EDGE_HOR && $type != EDGE_VER;
$score += 3 if $type == EDGE_CROSS; # crossings are doubleplusungood
$i += 3;
}
$score;
}
sub _create_cell
{
my ($self,$edge,$x,$y,$type) = @_;
my $cells = $self->{cells}; my $xy = "$x,$y";
if (ref($cells->{$xy}) && $cells->{$xy}->isa('Graph::Easy::Edge'))
{
$cells->{$xy}->_make_cross($edge,$type & EDGE_FLAG_MASK);
# insert a EDGE_HOLE into the cells of the edge (but not into the list of
# to-be-rendered cells). This cell will be removed by the optimizer later on.
Graph::Easy::Edge::Cell->new( type => EDGE_HOLE, edge => $edge, x => $x, y => $y );
return;
}
my $path = Graph::Easy::Edge::Cell->new( type => $type, edge => $edge, x => $x, y => $y );
$cells->{$xy} = $path; # store in cells
}
sub _path_is_clear
{
# For all points (x,y pairs) in the path, check that the cell is still free
# $path points to a list of [ x,y,type, x,y,type, ...]
my ($self,$path) = @_;
my $cells = $self->{cells};
my $i = 0;
while ($i < scalar @$path)
{
my $x = $path->[$i];
my $y = $path->[$i+1];
# my $t = $path->[$i+2];
$i += 3;
return 0 if exists $cells->{"$x,$y"}; # obstacle hit
}
1; # path is clear
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Path - Path management for Manhattan-style grids
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Scout> contains just the actual path-managing code for
L<Graph::Easy|Graph::Easy>, e.g. to create/destroy/maintain paths, node
placement etc.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS into Graph::Easy
This module injects the following methods into C<Graph::Easy>:
=head2 _path_is_clear()
$graph->_path_is_clear($path);
For all points (x,y pairs) in the path, check that the cell is still free.
C<$path> points to a list x,y,type pairs as in C<< [ [x,y,type], [x,y,type], ...] >>.
=head2 _create_cell()
my $cell = $graph->($edge,$x,$y,$type);
Create a cell at C<$x,$y> coordinates with type C<$type> for the specified
edge.
=head2 _path_is_clear()
$graph->_path_is_clear();
For all points (x,y pairs) in the path, check that the cell is still free.
C<$path> points to a list of C<[ x,y,type, x,y,type, ...]>.
Returns true when the path is clear, false otherwise.
=head2 _trace_path()
my $path = my $graph->_trace_path($src,$dst,$edge);
Find a free way from source node/group to destination node/group for the
specified edge. Both source and destination need to be placed beforehand.
=head1 METHODS in Graph::Easy::Node
This module injects the following methods into C<Graph::Easy::Node>:
=head2 _near_places()
my $node->_near_places();
Take a node and return a list of possible placements around it and
prune out already occupied cells. $d is the distance from the node
border and defaults to two (for placements). Set it to one for
adjacent cells.
=head2 _shuffle_dir()
my $dirs = $node->_shuffle_dir( [ 0,1,2,3 ], $dir);
Take a ref to an array with four entries and shuffle them around according to
C<$dir>.
=head2 _shift()
my $dir = $node->_shift($degrees);
Return a the C<flow()> direction shifted by X degrees to C<$dir>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

649
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Repair.pm Normal file
View File

@@ -0,0 +1,649 @@
#############################################################################
# Layout directed graphs on a flat plane. Part of Graph::Easy.
#
# Code to repair spliced layouts (after group cells have been inserted).
#
#############################################################################
package Graph::Easy::Layout::Repair;
$VERSION = '0.76';
#############################################################################
#############################################################################
# for layouts with groups:
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _edges_into_groups
{
my $self = shift;
# Put all edges between two nodes with the same group in the group as well
for my $edge (ord_values $self->{edges})
{
my $gf = $edge->{from}->group();
my $gt = $edge->{to}->group();
$gf->_add_edge($edge) if defined $gf && defined $gt && $gf == $gt;
}
$self;
}
sub _repair_nodes
{
# Splicing the rows/columns to add filler cells will have torn holes into
# multi-edges nodes, so we insert additional filler cells.
my ($self) = @_;
my $cells = $self->{cells};
# Make multi-celled nodes occupy the proper double space due to splicing
# in group cell has doubled the layout in each direction:
for my $n ($self->nodes())
{
# 1 => 1, 2 => 3, 3 => 5, 4 => 7 etc
$n->{cx} = $n->{cx} * 2 - 1;
$n->{cy} = $n->{cy} * 2 - 1;
}
# We might get away with not inserting filler cells if we just mark the
# cells as used (e.g. use only one global filler cell) since filler cells
# aren't actually rendered, anyway.
for my $cell (ord_values $cells)
{
next unless $cell->isa('Graph::Easy::Node::Cell');
# we have "[ empty ] [ filler ]" (unless cell is on the same column as node)
if ($cell->{x} > $cell->{node}->{x})
{
my $x = $cell->{x} - 1; my $y = $cell->{y};
# print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
$cells->{"$x,$y"} =
Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
}
# we have " [ empty ] "
# " [ filler ] " (unless cell is on the same row as node)
if ($cell->{y} > $cell->{node}->{y})
{
my $x = $cell->{x}; my $y = $cell->{y} - 1;
# print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
$cells->{"$x,$y"} =
Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
}
}
}
sub _repair_cell
{
my ($self, $type, $edge, $x, $y, $after, $before) = @_;
# already repaired?
return if exists $self->{cells}->{"$x,$y"};
# print STDERR "# Insert edge cell at $x,$y (type $type) for edge $edge->{from}->{name} --> $edge->{to}->{name}\n";
$self->{cells}->{"$x,$y"} =
Graph::Easy::Edge::Cell->new(
type => $type,
edge => $edge, x => $x, y => $y, before => $before, after => $after );
}
sub _splice_edges
{
# Splicing the rows/columns to add filler cells might have torn holes into
# edges, so we splice these together again.
my ($self) = @_;
my $cells = $self->{cells};
print STDERR "# Reparing spliced layout\n" if $self->{debug};
# Edge end/start points inside groups are not handled here, but in
# _repair_group_edge()
# go over the old layout, because the new cells were inserted into odd
# rows/columns and we do not care for these:
for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
{
next unless $cell->isa('Graph::Easy::Edge::Cell');
my $edge = $cell->{edge};
#########################################################################
# check for "[ JOINT ] [ empty ] [ edge ]"
my $x = $cell->{x} + 2; my $y = $cell->{y};
my $type = $cell->{type} & EDGE_TYPE_MASK;
# left is a joint and right exists
if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_E_N_S)
&& exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x,$y"};
# print STDERR "# at $x,$y\n";
# |-> [ empty ] [ node ]
if ($right->isa('Graph::Easy::Edge::Cell'))
{
# when the left one is a joint, the right one must be an edge
$self->error("Found non-edge piece ($right->{type} $right) right to a joint ($type)")
unless $right->isa('Graph::Easy::Edge::Cell');
# print STDERR "splicing in HOR piece to the right of joint at $x, $y ($edge $right $right->{edge})\n";
# insert the new piece before the first part of the edge after the joint
$self->_repair_cell(EDGE_HOR(), $right->{edge},$cell->{x}+1,$y,0)
if $edge != $right->{edge};
}
}
#########################################################################
# check for "[ edge ] [ empty ] [ joint ]"
$x = $cell->{x} - 2; $y = $cell->{y};
# right is a joint and left exists
if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_W_N_S)
&& exists $cells->{"$x,$y"})
{
my $left = $cells->{"$x,$y"};
# [ node ] [ empty ] [ <-| ]
if (!$left->isa('Graph::Easy::Node'))
{
# when the left one is a joint, the right one must be an edge
$self->error('Found non-edge piece right to a joint')
unless $left->isa('Graph::Easy::Edge::Cell');
# insert the new piece before the joint
$self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,0) # $left,$cell)
if $edge != $left->{edge};
}
}
#########################################################################
# check for " [ joint ]
# [ empty ]
# [ edge ]"
$x = $cell->{x}; $y = $cell->{y} + 2;
# top is a joint and down exists
if ( ($type == EDGE_S_E_W || $type == EDGE_E_N_S || $type == EDGE_W_N_S)
&& exists $cells->{"$x,$y"})
{
my $bottom = $cells->{"$x,$y"};
# when top is a joint, the bottom one must be an edge
$self->error('Found non-edge piece below a joint')
unless $bottom->isa('Graph::Easy::Edge::Cell');
# print STDERR "splicing in VER piece below joint at $x, $y\n";
# XXX TODO
# insert the new piece after the joint
$self->_repair_cell(EDGE_VER(), $bottom->{edge},$x,$cell->{y}+1,0)
if $edge != $bottom->{edge};
}
#########################################################################
# check for "[ --- ] [ empty ] [ ---> ]"
$x = $cell->{x} + 2; $y = $cell->{y};
if (exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x,$y"};
$self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,$cell,$right)
if $right->isa('Graph::Easy::Edge::Cell') &&
defined $right->{edge} && defined $right->{type} &&
# check that both cells belong to the same edge
( $edge == $right->{edge} ||
# or the right part is a cross
$right->{type} == EDGE_CROSS ||
# or the left part is a cross
$cell->{type} == EDGE_CROSS );
}
#########################################################################
# check for [ | ]
# [ empty ]
# [ | ]
$x = $cell->{x}; $y = $cell->{y}+2;
if (exists $cells->{"$x,$y"})
{
my $below = $cells->{"$x,$y"};
$self->_repair_cell(EDGE_VER(),$edge,$x,$cell->{y}+1,$cell,$below)
if $below->isa('Graph::Easy::Edge::Cell') &&
# check that both cells belong to the same edge
( $edge == $below->{edge} ||
# or the lower part is a cross
$below->{type} == EDGE_CROSS ||
# or the upper part is a cross
$cell->{type} == EDGE_CROSS );
}
} # end for all cells
$self;
}
sub _new_edge_cell
{
# create a new edge cell to be spliced into the layout for repairs
my ($self, $cells, $group, $edge, $x, $y, $after, $type) = @_;
$type += EDGE_SHORT_CELL() if defined $group;
my $e_cell = Graph::Easy::Edge::Cell->new(
type => $type, edge => $edge, x => $x, y => $y, after => $after);
$group->_del_cell($e_cell) if defined $group;
$cells->{"$x,$y"} = $e_cell;
}
sub _check_edge_cell
{
# check a start/end edge cell and if nec. repair it
my ($self, $cell, $x, $y, $flag, $type, $match, $check, $where) = @_;
my $edge = $cell->{edge};
if (grep { exists $_->{cell_class} && $_->{cell_class} =~ $match } ord_values ($check))
{
$cell->{type} &= ~ $flag; # delete the flag
$self->_new_edge_cell(
$self->{cells}, $edge->{group}, $edge, $x, $y, $where, $type + $flag);
}
}
sub _repair_group_edge
{
# repair an edges inside a group
my ($self, $cell, $rows, $cols, $group) = @_;
my $cells = $self->{cells};
my ($x,$y,$doit);
my $type = $cell->{type};
#########################################################################
# check for " [ empty ] [ |---> ]"
$x = $cell->{x} - 1; $y = $cell->{y};
$self->_check_edge_cell($cell, $x, $y, EDGE_START_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_W);
#########################################################################
# check for " [ <--- ] [ empty ]"
$x = $cell->{x} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_E);
#########################################################################
# check for " [ --> ] [ empty ]"
$x = $cell->{x} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_E);
# $self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_E_N_S, qr/g[rl]/, $cols->{$x}, -1)
# if (($type & EDGE_END_MASK) == EDGE_END_E);
#########################################################################
# check for " [ empty ] [ <-- ]"
$x = $cell->{x} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_W);
#########################################################################
#########################################################################
# vertical cases
#########################################################################
# check for [empty]
# [ | ]
$x = $cell->{x}; $y = $cell->{y} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_N);
#########################################################################
# check for [ |]
# [ empty ]
$y = $cell->{y} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_S);
#########################################################################
# check for [ v ]
# [empty]
$y = $cell->{y} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_S);
#########################################################################
# check for [ empty ]
# [ ^ ]
$y = $cell->{y} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_N);
}
sub _repair_edge
{
# repair an edge outside a group
my ($self, $cell, $rows, $cols) = @_;
my $cells = $self->{cells};
#########################################################################
# check for [ |\n|\nv ]
# [empty] ... [non-empty]
# [node]
my $x = $cell->{x}; my $y = $cell->{y} + 1;
my $below = $cells->{"$x,$y"}; # must be empty
if (!ref($below) && (($cell->{type} & EDGE_END_MASK) == EDGE_END_S))
{
if (grep { exists $_->{cell_class} && $_->{cell_class} =~ /g[tb]/ } ord_values $rows->{$y})
{
# delete the start flag
$cell->{type} &= ~ EDGE_END_S;
$self->_new_edge_cell($cells, undef, $cell->{edge}, $x, $y, -1,
EDGE_VER() + EDGE_END_S() );
}
}
# XXX TODO: do the other ends (END_N, END_W, END_E), too
}
sub _repair_edges
{
# fix edge end/start cells to be closer to the node cell they point at
my ($self, $rows, $cols) = @_;
my $cells = $self->{cells};
# go over all existing cells
for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
{
next unless $cell->isa('Graph::Easy::Edge::Cell');
# skip odd positions
next unless ($cell->{x} & 1) == 0 && ($cell->{y} & 1) == 0;
my $group = $cell->group();
$self->_repair_edge($cell,$rows,$cols) unless $group;
$self->_repair_group_edge($cell,$rows,$cols,$group) if $group;
} # end for all cells
}
sub _fill_group_cells
{
# after doing a layout(), we need to add the group to each cell based on
# what group the nearest node is in.
my ($self, $cells_layout) = @_;
print STDERR "\n# Padding with fill cells, have ",
scalar $self->groups(), " groups.\n" if $self->{debug};
# take a shortcut if we do not have groups
return $self if $self->groups == 0;
$self->{padding_cells} = 1; # set to true
# We need to insert "filler" cells around each node/edge/cell:
# To "insert" the filler cells, we simple multiply each X and Y by 2, this
# is O(N) where N is the number of actually existing cells. Otherwise we
# would have to create the full table-layout, and then insert rows/columns.
my $cells = {};
for my $key (sort keys %$cells_layout)
{
my ($x,$y) = split /,/, $key;
my $cell = $cells_layout->{$key};
$x *= 2;
$y *= 2;
$cell->{x} = $x;
$cell->{y} = $y;
$cells->{"$x,$y"} = $cell;
}
$self->{cells} = $cells; # override with new cell layout
$self->_splice_edges(); # repair edges
$self->_repair_nodes(); # repair multi-celled nodes
my $c = 'Graph::Easy::Group::Cell';
for my $cell (ord_values $self->{cells})
{
# DO NOT MODIFY $cell IN THE LOOP BODY!
my ($x,$y) = ($cell->{x},$cell->{y});
# find the primary node for node cells, for group check
my $group = $cell->group();
# not part of group, so no group-cells nec.
next unless $group;
# now insert up to 8 filler cells around this cell
my $ofs = [ -1, 0,
0, -1,
+1, 0,
+1, 0,
0, +1,
0, +1,
-1, 0,
-1, 0, ];
while (@$ofs > 0)
{
$x += shift @$ofs;
$y += shift @$ofs;
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y )
unless exists $cells->{"$x,$y"};
}
}
# Nodes positioned two cols/rows apart (f.i. y == 0 and y == 2) will be
# three cells apart (y == 0 and y == 4) after the splicing, the step above
# will not be able to close that hole - it will create fillers at y == 1 and
# y == 3. So we close these holes now with an extra step.
for my $cell (ord_values ( $self->{cells} ))
{
# only for filler cells
next unless $cell->isa('Graph::Easy::Group::Cell');
my ($sx,$sy) = ($cell->{x},$cell->{y});
my $group = $cell->{group};
my $x = $sx; my $y2 = $sy + 2; my $y = $sy + 1;
# look for:
# [ group ]
# [ empty ]
# [ group ]
if (exists $cells->{"$x,$y2"} && !exists $cells->{"$x,$y"})
{
my $down = $cells->{"$x,$y2"};
if ($down->isa('Graph::Easy::Group::Cell') && $down->{group} == $group)
{
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
}
}
$x = $sx+1; my $x2 = $sx + 2; $y = $sy;
# look for:
# [ group ] [ empty ] [ group ]
if (exists $cells->{"$x2,$y"} && !exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x2,$y"};
if ($right->isa('Graph::Easy::Group::Cell') && $right->{group} == $group)
{
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
}
}
}
# XXX TODO
# we should "grow" the group area to close holes
for my $group (ord_values ( $self->{groups} ))
{
$group->_set_cell_types($cells);
}
# create a mapping for each row/column so that we can repair edge starts/ends
my $rows = {};
my $cols = {};
for my $cell (ord_values ($cells))
{
$rows->{$cell->{y}}->{$cell->{x}} = $cell;
$cols->{$cell->{x}}->{$cell->{y}} = $cell;
}
$self->_repair_edges($rows,$cols); # insert short edge cells on group
# border rows/columns
# for all groups, set the cell carrying the label (top-left-most cell)
for my $group (ord_values ( $self->{groups} ))
{
$group->_find_label_cell();
}
# DEBUG:
# for my $cell (ord_values $cells)
# {
# $cell->_correct_size();
# }
#
# my $y = 0;
# for my $cell (sort { $a->{y} <=> $b->{y} || $a->{x} <=> $b->{x} } values %$cells)
# {
# print STDERR "\n" if $y != $cell->{y};
# print STDERR "$cell->{x},$cell->{y}, $cell->{w},$cell->{h}, ", $cell->{group}->{name} || 'none', "\t";
# $y = $cell->{y};
# }
# print STDERR "\n";
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Repair - Repair spliced layout with group cells
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Repair> contains code that can splice in
group cells into a layout, as well as repair the layout after that step.
It is part of L<Graph::Easy|Graph::Easy> and used automatically.
=head1 METHODS
C<Graph::Easy::Layout> injects the following methods into the C<Graph::Easy>
namespace:
=head2 _edges_into_groups()
Put the edges into the appropriate group and class.
=head2 _assign_ranks()
$graph->_assign_ranks();
=head2 _repair_nodes()
Splicing the rows/columns to add filler cells will have torn holes into
multi-edges nodes, so we insert additional filler cells to repair this.
=head2 _splice_edges()
Splicing the rows/columns to add filler cells might have torn holes into
multi-celled edges, so we splice these together again.
=head2 _repair_edges()
Splicing the rows/columns to add filler cells might have put "holes"
between an edge start/end and the node cell it points to. This
routine fixes this problem by extending the edge by one cell if
necessary.
=head2 _fill_group_cells()
After doing a C<layout()>, we need to add the group to each cell based on
what group the nearest node is in.
This routine will also find the label cell for each group, and repair
edge/node damage done by the splicing.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

1717
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Scout.pm Normal file
View File

File diff suppressed because it is too large Load Diff

2865
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node.pm Normal file
View File

File diff suppressed because it is too large Load Diff

116
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Anon.pm Normal file
View File

@@ -0,0 +1,116 @@
#############################################################################
# (c) by Tels 2004. Part of Graph::Easy. An anonymous (invisible) node.
#
#############################################################################
package Graph::Easy::Node::Anon;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
sub _init
{
my $self = shift;
$self->SUPER::_init(@_);
$self->{name} = '#' . $self->{id};
$self->{class} = 'node.anon';
$self->{att}->{label} = ' ';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
sub attributes_as_txt
{
my $self = shift;
$self->SUPER::attributes_as_txt( {
node => {
label => undef,
shape => undef,
class => undef,
} } );
}
sub as_pure_txt
{
'[ ]';
}
sub _as_part_txt
{
'[ ]';
}
sub as_txt
{
my $self = shift;
'[ ]' . $self->attributes_as_txt();
}
sub text_styles_as_css
{
'';
}
sub is_anon
{
# is an anon node
1;
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Anon - An anonymous, invisible node in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy::Node::Anon;
my $anon = Graph::Easy::Node::Anon->new();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Anon> represents an anonymous, invisible node.
These can be used to let edges start and end "nowhere".
The syntax in the Graph::Easy textual description language looks like this:
[ ] -> [ Bonn ] -> [ ]
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy::Node>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

140
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Cell.pm Normal file
View File

@@ -0,0 +1,140 @@
#############################################################################
# (c) by Tels 2004 - 2005. An empty filler cell. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Node::Cell;
use Graph::Easy::Node;
use strict;
use warnings;
use vars qw(@ISA $VERSION);
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = '';
$self->{name} = '';
$self->{'x'} = 0;
$self->{'y'} = 0;
# default: belongs to no node
$self->{node} = undef;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(node|graph|x|y)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node::Cell->new()");
}
$self->{$k} = $args->{$k};
}
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 0;
$self->{h} = 0;
$self;
}
sub node
{
# return the node this cell belongs to
my $self = shift;
$self->{node};
}
sub as_ascii
{
'';
}
sub as_html
{
'';
}
sub group
{
my $self = shift;
$self->{node}->group();
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Cell - An empty filler cell
=head1 SYNOPSIS
use Graph::Easy;
use Graph::Easy::Edge;
my $graph = Graph::Easy->new();
my $node = $graph->add_node('A');
my $path = Graph::Easy::Node::Cell->new(
graph => $graph, node => $node,
);
...
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Cell> is used to reserve a cell in the grid for nodes
that occupy more than one cell.
You should not need to use this class directly.
=head1 METHODS
=head2 error()
$last_error = $cell->error();
$cvt->error($error); # set new messages
$cvt->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 node()
my $node = $cell->node();
Returns the node this filler cell belongs to.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2005 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

69
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Empty.pm Normal file
View File

@@ -0,0 +1,69 @@
#############################################################################
# An empty, borderless cell. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Node::Empty;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->SUPER::_init($args);
$self->{class} = 'node.empty';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Empty - An empty, borderless cell in a node cluster
=head1 SYNOPSIS
my $cell = Graph::Easy::Node::Empty->new();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Empty> represents a borderless, empty cell in
a node cluster. It is mainly used to have an object to render collapsed
borders in ASCII output.
You should not need to use this class directly.
=head1 SEE ALSO
L<Graph::Easy::Node>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

1778
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Parser.pm Normal file
View File

File diff suppressed because it is too large Load Diff

2231
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Parser/Graphviz.pm Normal file
View File

File diff suppressed because it is too large Load Diff

1168
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Parser/VCG.pm Normal file
View File

File diff suppressed because it is too large Load Diff

51
perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Util.pm Normal file
View File

@@ -0,0 +1,51 @@
package Graph::Easy::Util;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = (qw(first_kv ord_values));
use List::Util qw(minstr);
=head1 FUNCTIONS
=head2 first_kv($hash_ref)
The first key value pair from a hash reference - lexicographically.
=cut
sub first_kv
{
my $href = shift;
my $n = minstr( keys(%$href) );
my $v = $href->{$n};
return ($n, $v);
}
=head2 ord_values($hash_ref)
The values of the hash ordered by a lexicographical keyname.
=cut
sub ord_values
{
my $href = shift;
if ((!defined $href) || (! %$href))
{
return (wantarray ? () : 0);
}
else
{
return (wantarray ? @{$href}{sort keys( %$href )} : scalar(keys(%$href)));
}
}
1;

0
perl/lib/Graph-Easy-0.76/blib/lib/auto/Graph/Easy/.exists Normal file
View File

0
perl/lib/Graph-Easy-0.76/blib/man1/.exists Normal file
View File

0
perl/lib/Graph-Easy-0.76/blib/man3/.exists Normal file
View File

0
perl/lib/Graph-Easy-0.76/blib/script/.exists Normal file
View File

712
perl/lib/Graph-Easy-0.76/blib/script/graph-easy Normal file
View File

@@ -0,0 +1,712 @@
#!/usr/bin/perl -w
use strict;
use Graph::Easy 0.63;
use Graph::Easy::Parser;
my $help_requested = 0;
# echo "[A]" | graph-easy # should work
# graph-easy # need help
$help_requested = 1 if @ARGV == 0 && -t STDIN;
# list of supported output formats for external renderers like dot:
my @external = qw/png bmp gif jpg pdf ps ps2 tif tga pcl hpgl/;
my $external = join('|',@external);
my $qr_ext = qr/^($external)\z/;
my $OUT = \*STDERR;
my $opt = get_options();
# error?
$help_requested = 1 if !ref($opt);
# no error and --help was specified
$help_requested = 2 if ref($opt) && $opt->{help} ne '';
my $copyright = "Graph::Easy v$Graph::Easy::VERSION (c) by Tels 2004-2008. "
."Released under the GPL 2.0 or later.\n\n";
if (ref($opt) && $opt->{version} != 0)
{
print $copyright;
print "Running under Perl v$]";
eval { require Graph::Easy::As_svg; };
if (defined $Graph::Easy::As_svg::VERSION)
{
print " and using Graph::Easy::As_svg v$Graph::Easy::As_svg::VERSION";
}
print ".\n\n";
exit 2;
}
if ($help_requested > 0)
{
print STDERR $copyright;
require Pod::Usage;
if ($help_requested > 1 && $Pod::Usage::VERSION < 1.35)
{
# The way old Pod::Usage executes "perldoc" might fail:
system('perldoc', $0);
exit 2;
}
Pod::Usage::pod2usage( { -exitval => 2, -verbose => $help_requested } );
}
my $verbose = $opt->{verbose};
print $OUT $copyright if $verbose;
#############################################################################
# Create the parser object
my $parser_class = 'Graph::Easy::Parser';
if ($opt->{from} eq 'graphviz')
{
require Graph::Easy::Parser::Graphviz;
$parser_class = 'Graph::Easy::Parser::Graphviz';
}
elsif ($opt->{from} =~ /^(vcg|gdl)\z/)
{
require Graph::Easy::Parser::VCG;
$parser_class = 'Graph::Easy::Parser::VCG';
}
print $OUT "Creating $parser_class object.\n" if $verbose;
my $parser = $parser_class->new( debug => $opt->{debug} );
#############################################################################
# parse the input file
print $OUT "Parsing input in $opt->{from} from $opt->{inputname}.\n" if $verbose;
my $graph = $parser->from_file($opt->{input});
my $error = '';
$error = $parser->error() if !$graph || $parser->error();
$error = $graph->error() if $graph && $graph->error();
die ($error) if $error;
#############################################################################
# If wanted, generate the statistics:
if ($opt->{stats})
{
print STDERR "\nInput is a ",
$graph->is_simple() ? 'simple' : 'multi-edged',
", ",
$graph->is_undirected() ? 'undirected' : 'directed',
" graph with:\n";
my $nodes = $graph->nodes();
my $edges = $graph->edges();
my $groups = $graph->groups();
print STDERR " $nodes node" . ($nodes != 1 ? 's' : '') .
", $edges edge" . ($edges != 1 ? 's' : '') .
" and $groups group" . ($groups != 1 ? 's' : '') . "\n\n";
for my $g ($graph->groups())
{
my $nodes = $g->nodes();
my $edges = $g->edges();
my $groups = $g->groups();
print STDERR " Group '$g->{name}':\n";
print STDERR " $nodes node" . ($nodes != 1 ? 's' : '') .
", $edges edge" . ($edges != 1 ? 's' : '') .
" and $groups group" . ($groups != 1 ? 's' : '') . "\n\n";
}
}
#############################################################################
# Generate the wanted output format and write it to the output:
if (! $opt->{parse})
{
my $method = 'as_' . $opt->{as} . '_file';
if ($verbose)
{
if ($opt->{outputname} =~ /\.$external\z/)
{
print $OUT "Piping output to '$opt->{renderer} -T$opt->{ext} -o \"$opt->{outputname}\"'.\n";
}
else
{
print $OUT "Writing output as $opt->{as} to $opt->{outputname}.\n";
}
}
$graph->timeout(abs($opt->{timeout} || 240));
my $FILE = $opt->{output};
print $FILE $graph->$method();
print $OUT "Everything done. Have fun!\n\n" if $verbose;
}
#############################################################################
# Everything done
#############################################################################
#############################################################################
sub get_options
{
# set the defaults
my $opt = {
input => undef,
output => undef,
as => '',
from => 'txt',
help => '',
as_ascii => '',
as_boxart => '',
as_html => '',
as_svg => '',
as_graphviz => '',
as_txt => '',
as_vcg => '',
as_gdl => '',
as_graphml => '',
debug => 0,
from_txt => '',
from_vcg => '',
from_gdl => '',
from_graphviz => '',
verbose => 0,
version => 0,
parse => 0,
stats => 0,
timeout => 240,
renderer => 'dot',
};
# insert the ones from @external
for my $e (@external) { $opt->{$e} = ''; }
# map the output format to the method to generate the output:
my $formats = {
html => 'html',
txt => 'ascii',
svg => 'svg',
dot => 'graphviz',
vcg => 'vcg',
gdl => 'gdl',
graphml => 'graphml',
};
# insert the ones from @external
for my $e (@external) { $formats->{$e} = 'graphviz'; }
# do we have some options?
if (@ARGV > 0)
{
require Getopt::Long;
my @o = (
"input=s" => \$opt->{input},
"output=s" => \$opt->{output},
"as=s" => \$opt->{as},
"from=s" => \$opt->{from},
"help|?" => \$opt->{help},
"version" => \$opt->{version},
"verbose" => \$opt->{verbose},
"debug=i" => \$opt->{debug},
"parse" => \$opt->{parse},
"as_ascii|ascii" => \$opt->{as_ascii},
"as_html|html" => \$opt->{as_html},
"as_svg|svg" => \$opt->{as_svg},
"as_txt|txt" => \$opt->{as_txt},
"as_vcg|vcg" => \$opt->{as_vcg},
"as_gdl|gdl" => \$opt->{as_gdl},
"as_graphml|graphml" => \$opt->{as_graphml},
"as_graphviz|graphviz|as_dot|dot" => \$opt->{as_graphviz},
"as_boxart|boxart" => \$opt->{as_boxart},
"timeout=i" => \$opt->{timeout},
"renderer=s" => \$opt->{renderer},
"stats" => \$opt->{stats},
"from_txt" => \$opt->{from_txt},
"from_vcg" => \$opt->{from_vcg},
"from_gdl" => \$opt->{from_gdl},
"from_graphviz" => \$opt->{from_graphviz},
);
# insert the ones from @external
for my $e (@external) { push @o, "as_$e|$e" => \$opt->{"as_$e"}; }
return unless Getopt::Long::GetOptions (@o);
}
# allow "as=dot" for easier usage:
$opt->{as} = 'graphviz' if $opt->{as} eq 'dot';
# make the renderer argument sane to avoid --renderer=';rm -fR *':
$opt->{renderer} =~ s/[^a-zA-Z0-9_\\\/\:\.-]//g;
# if there are arguments left, they are input and possible output
$opt->{input} = shift @ARGV if @ARGV;
$opt->{output} = shift @ARGV if @ARGV;
if (!defined $opt->{input})
{
$opt->{input} = \*STDIN;
$opt->{inputname} = 'STDIN';
}
else
{
$opt->{inputname} = $opt->{input};
}
# This code gets confused if the user specified multiple options. Not much
# can be done about that except whack the user with something heavy:
for my $format (qw/ascii boxart html svg txt graphviz vcg gdl graphml/, @external )
{
warn ("Warning: Output format '$format' overrides specified '$opt->{as}'")
if $opt->{"as_$format"} && $opt->{as};
$opt->{as} = $format if $opt->{"as_$format"};
delete $opt->{"as_$format"};
}
if ($opt->{as} =~ $qr_ext)
{
$opt->{output} = $opt->{input} unless defined $opt->{output};
# set some default output name, so the replace works correctly
$opt->{output} = 'graph.txt' if ref($opt->{input});
# two-step process to fix bug #37534 - overwrites input with no extension
# example.txt => example
$opt->{output} =~ s/\.(txt|dot|vcg|gdl|graphml|$external)\z//;
# example => example.png
$opt->{output} .= ".$opt->{as}";
}
if (!defined $opt->{output})
{
$opt->{outputname} = 'STDOUT';
$opt->{output} = \*STDOUT;
# default to ASCII if nothing is known
$opt->{as} = 'ascii' if $opt->{as} eq '';
}
else
{
my $file = $opt->{output};
$opt->{outputname} = $opt->{output};
if ($opt->{as} eq '')
{
$opt->{as} = 'ascii'; # default
$opt->{as} = $formats->{$1} if $file =~ /\.(html|svg|txt|dot|vcg|gdl|graphml|$external)\z/;
}
$opt->{output} = undef;
if ($opt->{as} !~ $qr_ext)
{
# do not clobber the output file if we cannot read the input
return unless ref $opt->{input} || -R $opt->{input};
open $opt->{output}, ">", $file or die ("Cannot write to $file: $!");
}
else
{
# open a pipe to dot/neato etc.
my $file_save = $file;
$file_save =~ s/["'\|;]//g; # remove potentially unsafe characters
open $opt->{output}, "|$opt->{renderer} -T$opt->{as} -o \"$file_save\"" or die ("Cannot open pipe to dot: $!");
binmode $opt->{output}, ':utf8';
}
}
if ($opt->{as} !~ $qr_ext)
{
binmode ($opt->{output}, ':utf8') or die ("Cannot do binmode(output,':utf8')");
}
else
{
$opt->{ext} = $opt->{as};
$opt->{as} = 'graphviz';
}
# convert "from_vcg" to "from=vcg"
for my $format (qw/txt graphviz dot vcg gdl/)
{
$opt->{from} = $format if $opt->{"from_$format"};
delete $opt->{"from_$format"};
}
$opt->{from} = 'graphviz' if $opt->{from} eq 'dot';
die ("Unknown input format '$opt->{from}'")
unless $opt->{from} =~ /^(vcg|gdl|graphviz|txt)\z/;
$opt;
}
__END__
=pod
=head1 NAME
graph-easy - render/convert graphs in/from various formats
=head1 SYNOPSIS
Convert between graph formats and layout/render graphs:
graph-easy [options] [inputfile [outputfile]]
echo "[ Bonn ] - car -> [ Berlin ]" | graph-easy
graph-easy --input=graph.dot --as_ascii
graph-easy --html --output=mygraph.html graph.txt
graph-easy graph.txt graph.svg
graph-easy graph.txt --as_dot | dot -Tpng -o graph.png
graph-easy graph.txt --png
graph-easy graph.vcg --dot
graph-easy graph.dot --gdl
graph-easy graph.dot --graphml
=head1 ARGUMENTS
Here are the most important options, more are listed in the full
documentation:
=over 10
=item --help
Print the full documentation, not just this short overview.
=item --input
Specify the input file name. Example:
graph-easy --input=input.txt
The format will be auto-detected, override it with L<--from>.
=item --output
Specify the output file name. Example:
graph-easy --output=output.txt input.txt
=item --as
Specify the output format. Example:
graph-easy --as=ascii input.txt
Valid formats are:
ascii ASCII art rendering
boxart Unicode Boxart rendering
html HTML
svg Scalable Vector Graphics
graphviz the DOT language
dot alias for "graphviz"
txt Graph::Easy text
vcg VCG (Visualizing Compiler Graphs - a subset of GDL) text
gdl GDL (Graph Description Language) text
graphml GraphML
In addition, the following formats are understood and piped through the program
specified with the --renderer option (default: dot):
bmp Windows bitmap
gif GIF
hpgl HP-GL/2 vector graphic
jpg JPEG
pcl PCL printer language
pdf PDF
png PNG
ps Postscript
ps2 Postscript with PDF notations (see graphviz documentation)
tga Targa bitmap
tif TIFF bitmap
The default format will be determined by the output filename extension,
and is C<ascii>, if the output filename was not set.
You can also use B<ONE> argument of the form C<--as_ascii> or C<--ascii>.
=item --from
Specify the input format. Valid formats are:
graphviz the DOT language
txt Graph::Easy text
vcg VCG text
gdl GDL (Graph Description Language) text
If not specified, the input format is auto-detected.
You can also use B<ONE> argument of the form C<--from_dot>, etc.
=item --renderer
The external program (default: "dot") used to render the output
formats like C<png>, C<jpg> etc. Some choices are "neato", "twopi", "fdp" or "circo".
=item --parse
Input will only be parsed, without any output generation.
Useful in combination with C<--debug=1> or C<--stats>. Example:
graph-easy input.txt --parse --debug=1
=item --stats
Write various statistics about the input graph to STDERR. Best used in
combination with C<--parse>:
graph-easy input.txt --parse --stats
=item --timeout
Set the timeout B<in seconds> for the Graph::Easy layouter that generates
ASCII, HTML, SVG or boxart output. If the layout does not
finish in this time, it will be aborted. Example:
graph-easy input.txt --timeout=500
Conversion to DOT, VCG/GDL, GraphML or plain text ignores the timeout.
The default is 240 seconds (4 minutes).
=item --verbose
Write info regarding the conversion process to STDERR.
=back
=head1 DESCRIPTION
C<graph-easy> reads a description of a graph (a connected network of
nodes and edges, not a pie chart :-) and then converts this to the desired
output format.
By default, the input will be read from STDIN, and the output will go to
STDOUT. The input is expected to be encoded in UTF-8, the output will
also be UTF-8.
It understands the following formats as input:
Graph::Easy http://bloodgate.com/perl/graph/manual/
DOT http://www.graphviz.org/
VCG http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
GDL http://www.aisee.com/
The formats are automatically detected, regardless of the input file name,
but you can also explicitly declare your input to be in one specific
format.
The output can be a dump of the graph in one of the following formats:
Graph::Easy http://bloodgate.com/perl/graph/manual/
DOT http://www.graphviz.org/
VCG http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
GDL http://www.aisee.com/
GraphML http://graphml.graphdrawing.org/
In addition, C<Graph::Easy> can also create layouts of graphs in
one of the following output formats:
HTML SVG ASCII BOXART
Note that for SVG output, you need to install the module
L<Graph::Easy::As_svg> first.
As a shortcut, you can also specify the output format as 'png', this will
cause C<graph-easy> to pipe the input in graphviz format to the C<dot> program
to create a PNG file in one step. The following two examples are equivalent:
graph-easy graph.txt --dot | dot -Tpng -o graph.png
graph-easy graph.txt --png
X<svg>
X<html>
X<ascii>
X<boxart>
X<png>
X<dot>
X<graphviz>
X<vcg>
X<gdl>
X<graph description language>
X<unicode>
=head1 OTHER ARGUMENTS
C<graph-easy> supports a few more arguments in addition to the ones from above:
=over 10
=item --version
Write version info and exit.
=item --debug=N
Set the debug level (1..3). Warning, this will generate huge
amounts of hard to understand output on STDERR. Example:
graph-easy input.txt --output=test.html --debug=1
=item --png, --dot, --vcg, --gdl, --txt, --ascii, --boxart, --html, --svg
Given exactly one of these options, produces the desired output format.
=back
=head1 EXAMPLES
=head2 ASCII output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy
+--------+ car +-----+
| Bonn | -----> | Ulm |
+--------+ +-----+
|
| car
v
+--------+
| Berlin |
+--------+
=head2 Graphviz example output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --dot
digraph GRAPH_0 {
edge [ arrowhead=open ];
graph [ rankdir=LR ];
node [
fontsize=11,
fillcolor=white,
style=filled,
shape=box ];
Bonn -> Ulm [ label=car ]
Bonn -> Berlin [ label=car ]
}
=head2 VCG example output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --vcg
graph: {
title: "Untitled graph"
node: { title: "Berlin" }
node: { title: "Bonn" }
node: { title: "Ulm" }
edge: { label: "car" sourcename: "Bonn" targetname: "Ulm" }
edge: { label: "car" sourcename: "Bonn" targetname: "Berlin" }
}
=head2 GDL example output
GDL (Graph Description Language) is a superset of VCG, and thus the output will
look almost the same as VCG:
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --gdl
graph: {
title: "Untitled graph"
node: { title: "Berlin" }
node: { title: "Bonn" }
node: { title: "Ulm" }
edge: { label: "car" source: "Bonn" target: "Ulm" }
edge: { label: "car" source: "Bonn" target: "Berlin" }
}
=head2 GraphML example output
GraphML is XML:
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --graphml
<?xml version="1.0" encoding="UTF-8"?>
<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
<!-- Created by Graph::Easy v0.58 at Mon Aug 20 00:01:25 2007 -->
<key id="d0" for="edge" attr.name="label" attr.type="string"/>
<graph id="G" edgedefault="directed">
<node id="Berlin">
</node>
<node id="Bonn">
</node>
<node id="Ulm">
</node>
<edge source="Bonn" target="Berlin">
<data key="d0">car</data>
</edge>
<edge source="Bonn" target="Ulm">
<data key="d0">car</data>
</edge>
</graph>
<graphml>
=head1 CAVEATS
Please note that it is impossible to convert 100% from one format to another
format since every graph language out there has features that are unique to
only this language.
In addition, the conversion process always converts the input first into an
L<Graph::Easy> graph, and then to the desired output format.
This means that only features and attributes that are actually valid in
Graph::Easy are supported yet. Work in making Graph::Easy an universal
format supporting as much as possible is still in progress.
Attributes that are not yet supported natively by Graph::Easy are converted
to custom attributes with a prefixed C<x-format->, f.i. C<x-dot->. Upon output
to the same format, these are converted back, but conversion to a different
format will lose these attributes.
For a list of what problems still remain, please see the TODO
file in the C<Graph::Easy> distribution on CPAN:
L<http://search.cpan.org/~tels/Graph-Easy/>
If you notice anything wrong, or miss attributes, please file a bug report on
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Graph-Easy>
so we can fix it and include the missing things into Graph::Easy!
X<bugreport>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the terms of the GPL.
See the LICENSE file of Graph::Easy for a copy of the GPL.
This product includes color specifications and designs developed by Cynthia
Brewer (L<http://colorbrewer.org/>). See the LICENSE file for the full license
text that applies to these color schemes.
X<gpl>
X<apache-style>
X<cynthia>
X<brewer>
X<colorscheme>
X<license>
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
=head1 SEE ALSO
More information can be found in the online manual of Graph::Easy:
L<http://bloodgate.com/perl/graph/manual/>
See also: L<Graph::Easy>, L<Graph::Easy::Manual>
=cut

728
perl/lib/Graph-Easy-0.76/blib/script/graph-easy.bat Normal file
View File

@@ -0,0 +1,728 @@
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S %0 %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
use strict;
use Graph::Easy 0.63;
use Graph::Easy::Parser;
my $help_requested = 0;
# echo "[A]" | graph-easy # should work
# graph-easy # need help
$help_requested = 1 if @ARGV == 0 && -t STDIN;
# list of supported output formats for external renderers like dot:
my @external = qw/png bmp gif jpg pdf ps ps2 tif tga pcl hpgl/;
my $external = join('|',@external);
my $qr_ext = qr/^($external)\z/;
my $OUT = \*STDERR;
my $opt = get_options();
# error?
$help_requested = 1 if !ref($opt);
# no error and --help was specified
$help_requested = 2 if ref($opt) && $opt->{help} ne '';
my $copyright = "Graph::Easy v$Graph::Easy::VERSION (c) by Tels 2004-2008. "
."Released under the GPL 2.0 or later.\n\n";
if (ref($opt) && $opt->{version} != 0)
{
print $copyright;
print "Running under Perl v$]";
eval { require Graph::Easy::As_svg; };
if (defined $Graph::Easy::As_svg::VERSION)
{
print " and using Graph::Easy::As_svg v$Graph::Easy::As_svg::VERSION";
}
print ".\n\n";
exit 2;
}
if ($help_requested > 0)
{
print STDERR $copyright;
require Pod::Usage;
if ($help_requested > 1 && $Pod::Usage::VERSION < 1.35)
{
# The way old Pod::Usage executes "perldoc" might fail:
system('perldoc', $0);
exit 2;
}
Pod::Usage::pod2usage( { -exitval => 2, -verbose => $help_requested } );
}
my $verbose = $opt->{verbose};
print $OUT $copyright if $verbose;
#############################################################################
# Create the parser object
my $parser_class = 'Graph::Easy::Parser';
if ($opt->{from} eq 'graphviz')
{
require Graph::Easy::Parser::Graphviz;
$parser_class = 'Graph::Easy::Parser::Graphviz';
}
elsif ($opt->{from} =~ /^(vcg|gdl)\z/)
{
require Graph::Easy::Parser::VCG;
$parser_class = 'Graph::Easy::Parser::VCG';
}
print $OUT "Creating $parser_class object.\n" if $verbose;
my $parser = $parser_class->new( debug => $opt->{debug} );
#############################################################################
# parse the input file
print $OUT "Parsing input in $opt->{from} from $opt->{inputname}.\n" if $verbose;
my $graph = $parser->from_file($opt->{input});
my $error = '';
$error = $parser->error() if !$graph || $parser->error();
$error = $graph->error() if $graph && $graph->error();
die ($error) if $error;
#############################################################################
# If wanted, generate the statistics:
if ($opt->{stats})
{
print STDERR "\nInput is a ",
$graph->is_simple() ? 'simple' : 'multi-edged',
", ",
$graph->is_undirected() ? 'undirected' : 'directed',
" graph with:\n";
my $nodes = $graph->nodes();
my $edges = $graph->edges();
my $groups = $graph->groups();
print STDERR " $nodes node" . ($nodes != 1 ? 's' : '') .
", $edges edge" . ($edges != 1 ? 's' : '') .
" and $groups group" . ($groups != 1 ? 's' : '') . "\n\n";
for my $g ($graph->groups())
{
my $nodes = $g->nodes();
my $edges = $g->edges();
my $groups = $g->groups();
print STDERR " Group '$g->{name}':\n";
print STDERR " $nodes node" . ($nodes != 1 ? 's' : '') .
", $edges edge" . ($edges != 1 ? 's' : '') .
" and $groups group" . ($groups != 1 ? 's' : '') . "\n\n";
}
}
#############################################################################
# Generate the wanted output format and write it to the output:
if (! $opt->{parse})
{
my $method = 'as_' . $opt->{as} . '_file';
if ($verbose)
{
if ($opt->{outputname} =~ /\.$external\z/)
{
print $OUT "Piping output to '$opt->{renderer} -T$opt->{ext} -o \"$opt->{outputname}\"'.\n";
}
else
{
print $OUT "Writing output as $opt->{as} to $opt->{outputname}.\n";
}
}
$graph->timeout(abs($opt->{timeout} || 240));
my $FILE = $opt->{output};
print $FILE $graph->$method();
print $OUT "Everything done. Have fun!\n\n" if $verbose;
}
#############################################################################
# Everything done
#############################################################################
#############################################################################
sub get_options
{
# set the defaults
my $opt = {
input => undef,
output => undef,
as => '',
from => 'txt',
help => '',
as_ascii => '',
as_boxart => '',
as_html => '',
as_svg => '',
as_graphviz => '',
as_txt => '',
as_vcg => '',
as_gdl => '',
as_graphml => '',
debug => 0,
from_txt => '',
from_vcg => '',
from_gdl => '',
from_graphviz => '',
verbose => 0,
version => 0,
parse => 0,
stats => 0,
timeout => 240,
renderer => 'dot',
};
# insert the ones from @external
for my $e (@external) { $opt->{$e} = ''; }
# map the output format to the method to generate the output:
my $formats = {
html => 'html',
txt => 'ascii',
svg => 'svg',
dot => 'graphviz',
vcg => 'vcg',
gdl => 'gdl',
graphml => 'graphml',
};
# insert the ones from @external
for my $e (@external) { $formats->{$e} = 'graphviz'; }
# do we have some options?
if (@ARGV > 0)
{
require Getopt::Long;
my @o = (
"input=s" => \$opt->{input},
"output=s" => \$opt->{output},
"as=s" => \$opt->{as},
"from=s" => \$opt->{from},
"help|?" => \$opt->{help},
"version" => \$opt->{version},
"verbose" => \$opt->{verbose},
"debug=i" => \$opt->{debug},
"parse" => \$opt->{parse},
"as_ascii|ascii" => \$opt->{as_ascii},
"as_html|html" => \$opt->{as_html},
"as_svg|svg" => \$opt->{as_svg},
"as_txt|txt" => \$opt->{as_txt},
"as_vcg|vcg" => \$opt->{as_vcg},
"as_gdl|gdl" => \$opt->{as_gdl},
"as_graphml|graphml" => \$opt->{as_graphml},
"as_graphviz|graphviz|as_dot|dot" => \$opt->{as_graphviz},
"as_boxart|boxart" => \$opt->{as_boxart},
"timeout=i" => \$opt->{timeout},
"renderer=s" => \$opt->{renderer},
"stats" => \$opt->{stats},
"from_txt" => \$opt->{from_txt},
"from_vcg" => \$opt->{from_vcg},
"from_gdl" => \$opt->{from_gdl},
"from_graphviz" => \$opt->{from_graphviz},
);
# insert the ones from @external
for my $e (@external) { push @o, "as_$e|$e" => \$opt->{"as_$e"}; }
return unless Getopt::Long::GetOptions (@o);
}
# allow "as=dot" for easier usage:
$opt->{as} = 'graphviz' if $opt->{as} eq 'dot';
# make the renderer argument sane to avoid --renderer=';rm -fR *':
$opt->{renderer} =~ s/[^a-zA-Z0-9_\\\/\:\.-]//g;
# if there are arguments left, they are input and possible output
$opt->{input} = shift @ARGV if @ARGV;
$opt->{output} = shift @ARGV if @ARGV;
if (!defined $opt->{input})
{
$opt->{input} = \*STDIN;
$opt->{inputname} = 'STDIN';
}
else
{
$opt->{inputname} = $opt->{input};
}
# This code gets confused if the user specified multiple options. Not much
# can be done about that except whack the user with something heavy:
for my $format (qw/ascii boxart html svg txt graphviz vcg gdl graphml/, @external )
{
warn ("Warning: Output format '$format' overrides specified '$opt->{as}'")
if $opt->{"as_$format"} && $opt->{as};
$opt->{as} = $format if $opt->{"as_$format"};
delete $opt->{"as_$format"};
}
if ($opt->{as} =~ $qr_ext)
{
$opt->{output} = $opt->{input} unless defined $opt->{output};
# set some default output name, so the replace works correctly
$opt->{output} = 'graph.txt' if ref($opt->{input});
# two-step process to fix bug #37534 - overwrites input with no extension
# example.txt => example
$opt->{output} =~ s/\.(txt|dot|vcg|gdl|graphml|$external)\z//;
# example => example.png
$opt->{output} .= ".$opt->{as}";
}
if (!defined $opt->{output})
{
$opt->{outputname} = 'STDOUT';
$opt->{output} = \*STDOUT;
# default to ASCII if nothing is known
$opt->{as} = 'ascii' if $opt->{as} eq '';
}
else
{
my $file = $opt->{output};
$opt->{outputname} = $opt->{output};
if ($opt->{as} eq '')
{
$opt->{as} = 'ascii'; # default
$opt->{as} = $formats->{$1} if $file =~ /\.(html|svg|txt|dot|vcg|gdl|graphml|$external)\z/;
}
$opt->{output} = undef;
if ($opt->{as} !~ $qr_ext)
{
# do not clobber the output file if we cannot read the input
return unless ref $opt->{input} || -R $opt->{input};
open $opt->{output}, ">", $file or die ("Cannot write to $file: $!");
}
else
{
# open a pipe to dot/neato etc.
my $file_save = $file;
$file_save =~ s/["'\|;]//g; # remove potentially unsafe characters
open $opt->{output}, "|$opt->{renderer} -T$opt->{as} -o \"$file_save\"" or die ("Cannot open pipe to dot: $!");
binmode $opt->{output}, ':utf8';
}
}
if ($opt->{as} !~ $qr_ext)
{
binmode ($opt->{output}, ':utf8') or die ("Cannot do binmode(output,':utf8')");
}
else
{
$opt->{ext} = $opt->{as};
$opt->{as} = 'graphviz';
}
# convert "from_vcg" to "from=vcg"
for my $format (qw/txt graphviz dot vcg gdl/)
{
$opt->{from} = $format if $opt->{"from_$format"};
delete $opt->{"from_$format"};
}
$opt->{from} = 'graphviz' if $opt->{from} eq 'dot';
die ("Unknown input format '$opt->{from}'")
unless $opt->{from} =~ /^(vcg|gdl|graphviz|txt)\z/;
$opt;
}
__END__
=pod
=head1 NAME
graph-easy - render/convert graphs in/from various formats
=head1 SYNOPSIS
Convert between graph formats and layout/render graphs:
graph-easy [options] [inputfile [outputfile]]
echo "[ Bonn ] - car -> [ Berlin ]" | graph-easy
graph-easy --input=graph.dot --as_ascii
graph-easy --html --output=mygraph.html graph.txt
graph-easy graph.txt graph.svg
graph-easy graph.txt --as_dot | dot -Tpng -o graph.png
graph-easy graph.txt --png
graph-easy graph.vcg --dot
graph-easy graph.dot --gdl
graph-easy graph.dot --graphml
=head1 ARGUMENTS
Here are the most important options, more are listed in the full
documentation:
=over 10
=item --help
Print the full documentation, not just this short overview.
=item --input
Specify the input file name. Example:
graph-easy --input=input.txt
The format will be auto-detected, override it with L<--from>.
=item --output
Specify the output file name. Example:
graph-easy --output=output.txt input.txt
=item --as
Specify the output format. Example:
graph-easy --as=ascii input.txt
Valid formats are:
ascii ASCII art rendering
boxart Unicode Boxart rendering
html HTML
svg Scalable Vector Graphics
graphviz the DOT language
dot alias for "graphviz"
txt Graph::Easy text
vcg VCG (Visualizing Compiler Graphs - a subset of GDL) text
gdl GDL (Graph Description Language) text
graphml GraphML
In addition, the following formats are understood and piped through the program
specified with the --renderer option (default: dot):
bmp Windows bitmap
gif GIF
hpgl HP-GL/2 vector graphic
jpg JPEG
pcl PCL printer language
pdf PDF
png PNG
ps Postscript
ps2 Postscript with PDF notations (see graphviz documentation)
tga Targa bitmap
tif TIFF bitmap
The default format will be determined by the output filename extension,
and is C<ascii>, if the output filename was not set.
You can also use B<ONE> argument of the form C<--as_ascii> or C<--ascii>.
=item --from
Specify the input format. Valid formats are:
graphviz the DOT language
txt Graph::Easy text
vcg VCG text
gdl GDL (Graph Description Language) text
If not specified, the input format is auto-detected.
You can also use B<ONE> argument of the form C<--from_dot>, etc.
=item --renderer
The external program (default: "dot") used to render the output
formats like C<png>, C<jpg> etc. Some choices are "neato", "twopi", "fdp" or "circo".
=item --parse
Input will only be parsed, without any output generation.
Useful in combination with C<--debug=1> or C<--stats>. Example:
graph-easy input.txt --parse --debug=1
=item --stats
Write various statistics about the input graph to STDERR. Best used in
combination with C<--parse>:
graph-easy input.txt --parse --stats
=item --timeout
Set the timeout B<in seconds> for the Graph::Easy layouter that generates
ASCII, HTML, SVG or boxart output. If the layout does not
finish in this time, it will be aborted. Example:
graph-easy input.txt --timeout=500
Conversion to DOT, VCG/GDL, GraphML or plain text ignores the timeout.
The default is 240 seconds (4 minutes).
=item --verbose
Write info regarding the conversion process to STDERR.
=back
=head1 DESCRIPTION
C<graph-easy> reads a description of a graph (a connected network of
nodes and edges, not a pie chart :-) and then converts this to the desired
output format.
By default, the input will be read from STDIN, and the output will go to
STDOUT. The input is expected to be encoded in UTF-8, the output will
also be UTF-8.
It understands the following formats as input:
Graph::Easy http://bloodgate.com/perl/graph/manual/
DOT http://www.graphviz.org/
VCG http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
GDL http://www.aisee.com/
The formats are automatically detected, regardless of the input file name,
but you can also explicitly declare your input to be in one specific
format.
The output can be a dump of the graph in one of the following formats:
Graph::Easy http://bloodgate.com/perl/graph/manual/
DOT http://www.graphviz.org/
VCG http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
GDL http://www.aisee.com/
GraphML http://graphml.graphdrawing.org/
In addition, C<Graph::Easy> can also create layouts of graphs in
one of the following output formats:
HTML SVG ASCII BOXART
Note that for SVG output, you need to install the module
L<Graph::Easy::As_svg> first.
As a shortcut, you can also specify the output format as 'png', this will
cause C<graph-easy> to pipe the input in graphviz format to the C<dot> program
to create a PNG file in one step. The following two examples are equivalent:
graph-easy graph.txt --dot | dot -Tpng -o graph.png
graph-easy graph.txt --png
X<svg>
X<html>
X<ascii>
X<boxart>
X<png>
X<dot>
X<graphviz>
X<vcg>
X<gdl>
X<graph description language>
X<unicode>
=head1 OTHER ARGUMENTS
C<graph-easy> supports a few more arguments in addition to the ones from above:
=over 10
=item --version
Write version info and exit.
=item --debug=N
Set the debug level (1..3). Warning, this will generate huge
amounts of hard to understand output on STDERR. Example:
graph-easy input.txt --output=test.html --debug=1
=item --png, --dot, --vcg, --gdl, --txt, --ascii, --boxart, --html, --svg
Given exactly one of these options, produces the desired output format.
=back
=head1 EXAMPLES
=head2 ASCII output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy
+--------+ car +-----+
| Bonn | -----> | Ulm |
+--------+ +-----+
|
| car
v
+--------+
| Berlin |
+--------+
=head2 Graphviz example output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --dot
digraph GRAPH_0 {
edge [ arrowhead=open ];
graph [ rankdir=LR ];
node [
fontsize=11,
fillcolor=white,
style=filled,
shape=box ];
Bonn -> Ulm [ label=car ]
Bonn -> Berlin [ label=car ]
}
=head2 VCG example output
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --vcg
graph: {
title: "Untitled graph"
node: { title: "Berlin" }
node: { title: "Bonn" }
node: { title: "Ulm" }
edge: { label: "car" sourcename: "Bonn" targetname: "Ulm" }
edge: { label: "car" sourcename: "Bonn" targetname: "Berlin" }
}
=head2 GDL example output
GDL (Graph Description Language) is a superset of VCG, and thus the output will
look almost the same as VCG:
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --gdl
graph: {
title: "Untitled graph"
node: { title: "Berlin" }
node: { title: "Bonn" }
node: { title: "Ulm" }
edge: { label: "car" source: "Bonn" target: "Ulm" }
edge: { label: "car" source: "Bonn" target: "Berlin" }
}
=head2 GraphML example output
GraphML is XML:
echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --graphml
<?xml version="1.0" encoding="UTF-8"?>
<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
<!-- Created by Graph::Easy v0.58 at Mon Aug 20 00:01:25 2007 -->
<key id="d0" for="edge" attr.name="label" attr.type="string"/>
<graph id="G" edgedefault="directed">
<node id="Berlin">
</node>
<node id="Bonn">
</node>
<node id="Ulm">
</node>
<edge source="Bonn" target="Berlin">
<data key="d0">car</data>
</edge>
<edge source="Bonn" target="Ulm">
<data key="d0">car</data>
</edge>
</graph>
<graphml>
=head1 CAVEATS
Please note that it is impossible to convert 100% from one format to another
format since every graph language out there has features that are unique to
only this language.
In addition, the conversion process always converts the input first into an
L<Graph::Easy> graph, and then to the desired output format.
This means that only features and attributes that are actually valid in
Graph::Easy are supported yet. Work in making Graph::Easy an universal
format supporting as much as possible is still in progress.
Attributes that are not yet supported natively by Graph::Easy are converted
to custom attributes with a prefixed C<x-format->, f.i. C<x-dot->. Upon output
to the same format, these are converted back, but conversion to a different
format will lose these attributes.
For a list of what problems still remain, please see the TODO
file in the C<Graph::Easy> distribution on CPAN:
L<http://search.cpan.org/~tels/Graph-Easy/>
If you notice anything wrong, or miss attributes, please file a bug report on
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Graph-Easy>
so we can fix it and include the missing things into Graph::Easy!
X<bugreport>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the terms of the GPL.
See the LICENSE file of Graph::Easy for a copy of the GPL.
This product includes color specifications and designs developed by Cynthia
Brewer (L<http://colorbrewer.org/>). See the LICENSE file for the full license
text that applies to these color schemes.
X<gpl>
X<apache-style>
X<cynthia>
X<brewer>
X<colorscheme>
X<license>
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
=head1 SEE ALSO
More information can be found in the online manual of Graph::Easy:
L<http://bloodgate.com/perl/graph/manual/>
See also: L<Graph::Easy>, L<Graph::Easy::Manual>
=cut
__END__
:endofperl

43
perl/lib/Graph-Easy-0.76/examples/as_ascii Normal file
View File

@@ -0,0 +1,43 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# ASCII art.
# Example usage:
# examples/as_ascii t/in/2nodes.txt
# echo "[ A ] -> [ B ]" | examples/as_ascii
BEGIN { $|++; }
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $id = shift || '';
my $debug = shift;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
binmode STDERR, ':utf8' or die ("binmode STDERR, ':utf8' failed: $!");
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->id($id);
$graph->timeout(360);
$graph->layout();
warn($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_ascii();

43
perl/lib/Graph-Easy-0.76/examples/as_boxart Normal file
View File

@@ -0,0 +1,43 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# ASCII art using "box drawing" Unicode characters.
# Example usage:
# examples/as_boxart t/in/2nodes.txt
# echo "[ A ] -> [ B ]" | examples/as_boxart
BEGIN { $|++; }
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $id = shift || '';
my $debug = shift;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->id($id);
$graph->timeout(360);
$graph->layout();
warn($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_boxart();

44
perl/lib/Graph-Easy-0.76/examples/as_boxart_html Normal file
View File

@@ -0,0 +1,44 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# ASCII art using "box drawing" Unicode characters.
# Example usage:
# examples/as_boxart t/in/2nodes.txt
# echo "[ A ] -> [ B ]" | examples/as_boxart
BEGIN { $|++; }
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $id = shift || '';
my $debug = shift;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->id($id);
$graph->timeout(360);
$graph->layout();
warn($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
#print $graph->as_boxart();
print $graph->as_boxart_html_file();

35
perl/lib/Graph-Easy-0.76/examples/as_graphviz Normal file
View File

@@ -0,0 +1,35 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# graphviz output that can be feed to dot etc.
# Example usage:
# examples/as_graphviz t/in/2nodes.txt | dot -Tpng >test.png
# echo "[ A ] -> [ B ]" | examples/as_graphviz | dot -Tpng >test.png
BEGIN { $|++; }
use strict;
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $parser = Graph::Easy::Parser->new( debug => 0 );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
binmode STDERR, ':utf8' or die ("binmode STDERR, ':utf8' failed: $!");
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_graphviz();

43
perl/lib/Graph-Easy-0.76/examples/as_html Normal file
View File

@@ -0,0 +1,43 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# an HTML page.
# Example usage:
# examples/as_html t/in/2nodes.txt >test.html
# echo "[ A ] -> [ B ]" | examples/as_ascii
BEGIN { $|++; }
use strict;
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $id = shift || '';
my $debug = shift || 0;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
binmode STDERR, ':utf8' or die ("binmode STDERR, ':utf8' failed: $!");
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->id($id);
$graph->timeout(360);
$graph->layout();
warn ($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_html_page();

40
perl/lib/Graph-Easy-0.76/examples/as_svg Normal file
View File

@@ -0,0 +1,40 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy description to
# standalone SVG file
# Example usage:
# examples/as_svg t/in/2nodes.txt >test.svg
# echo "[ A ] -> [ B ]" | examples/as_svg
BEGIN { $|++; }
use strict;
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $debug = shift;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
binmode STDERR, ':utf8' or die ("binmode STDERR, ':utf8' failed: $!");
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->timeout(360);
$graph->layout();
warn ($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_svg_file();

39
perl/lib/Graph-Easy-0.76/examples/as_txt Normal file
View File

@@ -0,0 +1,39 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/graph-easy script -
# which is after "make install" available on any command line in your system.
# Convert an input file containing a Graph::Easy object, then dump
# it again as textual description.
# Example usage:
# examples/as_txt t/in/2nodes.txt
# echo "[ A ] -> [ B ]" | examples/as_txt
BEGIN { $|++; }
use lib 'lib';
use Graph::Easy::Parser;
my $file = shift;
my $id = shift || '';
my $debug = shift;
my $parser = Graph::Easy::Parser->new( debug => $debug );
if (!defined $file)
{
$file = \*STDIN;
binmode STDIN, ':utf8' or die ("binmode STDIN, ':utf8' failed: $!");
}
my $graph = $parser->from_file( $file );
die ($parser->error()) unless defined $graph;
$graph->id($id);
warn($graph->error()) if $graph->error();
binmode STDOUT, ':utf8' or die ("binmode STDOUT, ':utf8' failed: $!");
print $graph->as_txt();

28
perl/lib/Graph-Easy-0.76/examples/ascii.pl Normal file
View File

@@ -0,0 +1,28 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/grapheasy script -
# which is after "make install" available in your system as simple as
# "grapheasy" on any command line prompt.
#############################################################################
# This script uses examples/common.pl to generate some example graphs and
# displays them in ASCII.
use strict;
use warnings;
BEGIN { chdir 'examples' if -d 'examples'; }
require "common.pl";
sub out
{
my ($graph,$method) = @_;
$method = 'as_' . $method;
print $graph->$method(), "\n";
}
gen_graphs ();

179
perl/lib/Graph-Easy-0.76/examples/base.css Normal file
View File

@@ -0,0 +1,179 @@
h1
{
border: 1px solid black;
padding: 0.2em;
background: #fff0f0;
margin-bottom: 0;
margin-top: 0;
padding-left: 0.5em;
}
h2
{
border: 1px solid gray;
border-bottom: none;
padding: 0.2em;
padding-left: 0.5em;
background: #e0e0f0;
margin-top: 0.8em;
margin-bottom: 0;
}
div.h3
{
border-bottom: 1px solid gray;
padding: 0.2em;
padding-left: 0.1em;
margin-top: 0;
margin-bottom: 0;
font-weight: bold;
font-size: 1.2em;
}
h2.green { background: #e0f0e0; }
h2.coral { background: #e0f0f0; }
h2.purple { background: #f0e0f0; }
h2.orange { background: #fff0d0; }
h2.brown { background: #e0b090; }
h2.lime { background: #e0f090; }
h2.honey { background: #f0f0a0; }
h2.mint { background: #c0ffe0; }
div.footer
{
background: #f0f0f0;
border: 1px solid gray;
padding: 0.6em;
padding-left: 1.6em;
font-size: small;
margin-top: 1em;
margin-bottom: 1em;
font-size: 0.8em;
}
p.hr
{
padding-top: 0.3em;
border: none;
border-top: 1px solid gray;
}
div.right
{
margin-left: 8.2em;
}
div.text
{
border: 1px solid gray;
padding: 0.5em;
padding-left: 1.5em;
background: #e8e8e8;
font-size: 0.9em;
}
.clear { clear: both; }
a.top
{
font-size: 0.8em;
float: right;
position: relative;
top: -2.5em;
right: 0.5em;
color: black;
font-weight: bold;
text-decoration: none;
padding: 0.2em;
}
a.top:hover
{
color: white;
background: black;
padding: 0.2em;
}
.menubck, .menuext, .menucur, .menuadd, .menuind, .menuinc, .menucin
{
display: block;
border: 1px solid gray;
padding: 0.1em;
padding-left: 0.5em;
margin: 0;
margin-bottom: 0.4em;
min-width: 7em;
font-size: 0.75em;
text-decoration: none;
background: #e0e0ff;
color: black;
}
.menuind, .menuinc, .menucin
{
min-width: 6em;
margin-left: 1em;
background: #e0e0ff;
}
.menu
{
background: white;
padding: 0em;
margin: 0;
border: none;
width: 7em;
margin-right: 0.2em;
position: fixed;
}
.menucur, .menucin { border-color: #404040; }
.menucin { background: #a0a0ff; }
.menucur { background: #a0a0ff; }
.menuadd { background: #f0a0a0; }
.menuind { background: #d0d0ff; }
.menubck { background: #f0b0b0; }
:hover
{
color: #ffffff;
background: #000000;
}
.menubck:hover, .menuadd:hover { background: #a03030; }
.menucur:hover { background: #000080; }
.menuind:hover, .menucin:hover { background: #3030a0; }
img.i
{
border: none;
}
img
{
border: 1px solid gray;
margin-top: 0.7em;
margin-bottom: 0.7em;
}
p, li
{
max-width: 50em;
}
p {
padding-bottom: 0;
margin-bottom: 0.4em;
margin-top: 0.4em;
}
ul
{
list-style: square;
}
li
{
font-size: 0.9em;
}
tr.odd td
{
background: #ffdead;
}
code
{
background: #ffffff;
color: black;
padding: 2px;
}
pre
{
background: #d0d0d0;
color: black;
padding: 0.8em;
margin-left: 1em;
margin-bottom: 2.5em;
border: 1px solid black;
max-width: 40em;
}

74
perl/lib/Graph-Easy-0.76/examples/common.pl Normal file
View File

@@ -0,0 +1,74 @@
#!/usr/bin/perl -w
#############################################################################
# This script is used by both examples/ascii.pl and examples/html.pl to
# generate some sample graphs and then outputting them in the desired format.
use strict;
use warnings;
BEGIN
{
use lib '../lib';
}
use Graph::Easy;
sub gen_graphs
{
my $graph = shift || Graph::Easy->new();
my $method = shift || 'ascii';
###########################################################################
my $node = $graph->add_node( 'Bonn' );
my $node2 = $graph->add_node( 'Berlin' );
$graph->add_edge( $node, $node2 );
out ($graph, $method);
###########################################################################
$graph->{debug} = 0;
my $node3 = $graph->add_node( 'Frankfurt' );
$node3->set_attribute('border-style', 'dotted');
my $edge3 = Graph::Easy::Edge->new( style => 'double' );
$graph->add_edge( $node2, $node3, $edge3 );
out ($graph, $method);
###########################################################################
$graph->add_edge( $node3, 'Dresden' );
out ($graph, $method);
###########################################################################
$graph->add_edge( $node2, 'Potsdam' );
out ($graph, $method);
###########################################################################
my $node6 = $graph->add_node( 'Cottbus',);
$node6->set_attribute('border', '1px red dashed');
my $edge5 = $graph->add_edge( 'Potsdam', $node6 );
out ($graph, $method);
###########################################################################
$graph->add_edge( $node6, $node3 );
out ($graph, $method);
$graph->add_edge( $node6, $node3 );
out ($graph, $method);
}
1;

22
perl/lib/Graph-Easy-0.76/examples/complex.txt Normal file
View File

@@ -0,0 +1,22 @@
graph {
border: 1px solid black;
fill: oldlace;
background: goldenrod;
label: My sample graph;
}
edge { label-color: green; color: blue; }
[ One ] { fill: seagreen; color: white; } -- label --> [ Two ] { shape: triangle; }
[ One ] => { arrow-style: closed; } [ Three ]
[ Five ] { fill: maroon; color: yellow; } <=> [ Three ]
[ One ] .. Test\n label ..> [ Four ]
[ Three ] { border-style: dashed; }
.. Test\n label ..> { arrow-style: closed; } [ Six ] { label: Sixty\n Six\nand\nsix; }
[ Five ] - Test label - > { label-color: darkslategrey; color: red; } [ Seven ]
[ Seven ] -- [ Eight ]
[ Five ] --> [ Eight ]
[ Five ] --> [ Seven ]
[ Two ] -> [ Four ]
[ Three ] <-- Test label --> { arrow-style: closed; } [ Six ]
[ Eight ] .. [ None ] { shape: none; fill: red; color: brown; }

59
perl/lib/Graph-Easy-0.76/examples/fun.tpl Normal file
View File

@@ -0,0 +1,59 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>&lt;graph&gt;-Plugin for Mediawiki - Syntax</title>
<meta name="MSSmartTagsPreventParsing" content="TRUE">
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta http-equiv="imagetoolbar" content="no">
<link rel="stylesheet" type="text/css" href="base.css">
<style type="text/css">
<!--
.graph { margin-left: 2em; }
pre { margin-right: 1.5em; }
h3 { border-bottom: 1px solid #404040; padding-bottom: 0.3em; }
a.top { top: -3.5em; }
-->
</style>
</head>
<body bgcolor=white text=black>
<a name="top"></a>
<div class="menu">
<a class="menubck" href="index.html" title="Back to the main page">Main</a>
</div>
<div class="right">
<h1>&lt;graph&gt;-Plugin for Mediawiki</h1>
<h2>Table of Contents:</h2>
<div class="text">
##TOC##
<p>
To see the input text for each graph, follow the <font color="red">Source</font> link in each section.
</p>
</div>
<h2>Fun with Graphs</h2>
<div class="text">
##HTML##
</div>
<div class="footer">
<p>
This page was automatically created at <strong><small>##time##</small></strong> by <code>examples/syntax.pl</code> running
<a href="http://search.cpan.org/~tels/Graph-Simple/" title="Get it from search.cpan.org">Graph::Easy</a> v##version##.
Contact <a href="/mail.html">Tels</a> for help.
</p>
</div>
</div> <!-- right cell ends here -->
</body></html>

6
perl/lib/Graph-Easy-0.76/examples/history.txt Normal file
View File

@@ -0,0 +1,6 @@
[ Bonn ] -> [ Berlin ]
[ Berlin ] -> [ Frankfurt ]
[ Frankfurt ] -> [ Dresden ]
[ Berlin ] -> [ Potsdam ]
[ Potsdam ] -> [ Cottbus ] { border-color: red; }
[ Cottbus ] -> [ Frankfurt ]

113
perl/lib/Graph-Easy-0.76/examples/html.pl Normal file
View File

@@ -0,0 +1,113 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/grapheasy script -
# which is after "make install" available in your system as simple as
# "grapheasy" on any command line prompt.
#############################################################################
# This script uses examples/common.pl to generate some example graphs and
# prints them as HTML page. Use it like:
# ewxamples/html.pl >test.html
# and then open test.html in your favourite browser.
use strict;
use warnings;
BEGIN { chdir 'examples' if -d 'examples'; }
require "common.pl";
my $graph = Graph::Easy->new();
my @toc = ();
my $html = $graph->html_page_header();
$html .= <<HTML
<style type="text/css">
h1 { border-bottom: 1px solid black; padding-bottom: 0.2em; }
h2 { border-bottom: 1px solid grey; padding-bottom: 0.2em; margin-bottom: 0em; }
div { margin-left: 2em; }
.graph { margin-left: 2em; }
</style>
<h1>Graph-Simple Test page</h1>
<p>
This page was automatically created at <small>##time##</small> by <code>examples/html.pl</code> running
<a href="http://search.cpan.org/~tels/Graph-Simple/" title="Get it from search.cpan.org">Graph::Easy</a> v##version##.
</p>
<p>
On each of the following testcases you will see a text representation of the graph on the left side,
and on the right side the automatically generated HTML+CSS code.
</p>
<p>
Notes:
</p>
<ul>
<li>The text representation does not yet carry node attributes, like colors or border style.
<li>The HTML does not yet have "pretty" edges. This will be fixed later.
<li>The limitations in <a href="http://search.cpan.org/~tels/Graph-Simple/lib/Graph/Simple.pm#LIMITATIONS">Graph::Easy</a> apply.
</ul>
<h2>Testcases:</h2>
##TOC##
HTML
;
# generate the parts and push their names into @toc
gen_graphs($graph, 'html');
$html .= $graph->html_page_footer();
my $toc = '<ul>';
for my $t (@toc)
{
my $n = $t; $n =~ s/\s/_/;
$toc .= " <li><a href=\"#$n\">" . $t . "</a>\n";
}
$toc .= "</ul>\n";
# insert the TOC
$html =~ s/##TOC##/ $toc /;
$html =~ s/##time##/ scalar localtime() /e;
$html =~ s/##version##/$Graph::Easy::VERSION/e;
print $html;
# all done;
1;
#############################################################################
sub out
{
my ($graph,$method) = @_;
$method = 'as_' . $method;
my $t = $graph->nodes() . ' Nodes, ' . $graph->edges . ' Edges';
my $n = $t; $n =~ s/\s/_/;
$html .= "<a name=\"$n\"><h2>$t</h2></a>\n" .
"<div style='float: left; min-widht: 30%'>\n" .
"<h3>As Text</h3>\n" .
"<pre>" . $graph->as_txt() . "</pre></div>" .
"<div style='float: left;'>\n" .
"<h3>As HTML:</h3>\n" .
$graph->$method() . "</div>\n" .
"<div style='clear: both;'>&nbsp;</div>\n\n";
push @toc, $t;
}

39
perl/lib/Graph-Easy-0.76/examples/parse Normal file
View File

@@ -0,0 +1,39 @@
#!/usr/bin/perl -w
BEGIN { $|++; }
use strict;
use lib 'lib';
use Graph::Easy::Parser;
print "# Graph::Easy v$Graph::Easy::VERSION\n";
my $file = shift;
$file = \*STDIN unless defined $file;
my $id = shift || '';
my $debug = shift || 0;
my $parser = Graph::Easy::Parser->new( debug => $debug );
my $graph = $parser->from_file( $file );
print "# input: '$file'\n";
die ($parser->error()) unless defined $graph;
print "# Graph has ", scalar $graph->nodes(),
" nodes and ", scalar $graph->edges()," edges.\n";
$graph->id($id);
$graph->timeout(240);
$graph->layout();
warn ($graph->error()) if $graph->error();
print $graph->as_txt();
print $graph->as_ascii(), "\n";
print "<style type='text/css'>\n<!--\n",
$graph->css(), "--></style>\n", $graph->as_html();

211
perl/lib/Graph-Easy-0.76/examples/syntax.pl Normal file
View File

@@ -0,0 +1,211 @@
#!/usr/bin/perl -w
#############################################################################
# This example is a bit outdated, please use the new bin/grapheasy script -
# which is after "make install" available in your system as simple as
# "grapheasy" on any command line prompt.
#############################################################################
# This script tries to generate graphs from all the files in t/syntax/
# and outputs the result as an HTML page.
# Use it like:
# examples/syntax.pl >test.html
# and then open test.html in your favourite browser.
BEGIN
{
chdir 'examples' if -d 'examples';
use lib '../lib';
}
use strict;
use warnings;
use Graph::Easy::Parser;
my $parser = Graph::Easy::Parser->new( debug => 0);
my ($name, $template, $sep, @dirs) = @ARGV;
$name = 'Graph::Easy Test page' unless $name;
$template = 'syntax.tpl' unless $template;
my @toc = ();
open FILE, $template or die ("Cannot read 'syntax.tpl': $!");
local $/ = undef;
my $html = <FILE>;
close FILE;
my $output = ''; my $ID = '0';
# generate the parts and push their names into @toc
gen_graphs($parser, @dirs);
my $toc = '<ul>';
for my $t (@toc)
{
$toc .= " <li><a href='#$t->[0]'>$t->[1]</a>\n";
}
$toc .= "</ul>\n";
# insert the TOC
$html =~ s/##TOC##/ $toc /;
$html =~ s/##NAME##/ $name /;
$html =~ s/##HTML##/ $output /;
$html =~ s/##time##/ scalar localtime() /eg;
$html =~ s/##version##/$Graph::Easy::VERSION/eg;
print $html;
# all done;
1;
#############################################################################
sub gen_graphs
{
# for all files in a dir, generate a graph from it
my $parser = shift;
@dirs = qw/syntax stress/ unless @dirs;
foreach my $dir (@dirs)
{
_for_all_files($parser, $dir);
}
}
sub _for_all_files
{
my ($parser, $dir) = @_;
opendir DIR, "../t/$dir" or die ("Cannot read dir '../t/$dir': $!");
my @files = readdir DIR;
closedir DIR;
foreach my $file (sort @files)
{
my $f = "../t/$dir/" . $file;
next unless -f $f; # not a file?
print STDERR "# at file $f\n";
open FILE, "$f" or die ("Cannot read '$f': $!");
local $/ = undef;
my $input = <FILE>;
close FILE;
my $graph = $parser->from_text( $input );
if (!defined $graph)
{
my $error = $parser->error();
$output .=
"<h2>$dir/$file</h2>" .
"<a class='top' href='#top' title='Go to the top'>Top -^</a>\n".
"<div class='text'>\n".
"Error: Could not parse input from $file: <b style='color: red;'>$error</b>".
"<br>Input was:\n" .
"<pre>$input</pre>\n".
"</div>\n";
next;
}
$graph->timeout(100);
$graph->layout();
if ($graph->error())
{
my $error = $graph->error();
$output .=
"<h2>$dir/$file</h2>" .
"<a class='top' href='#top' title='Go to the top'>Top -^</a>\n".
"<div class='text'>\n".
"Error: $error</b>".
"<br>Input was:\n" .
"<pre>$input</pre>\n".
"</div>\n";
next;
}
$output .= out ($input, $graph, 'html', $dir, $file);
}
}
sub out
{
my ($txt,$graph,$method,$dir, $file) = @_;
$method = 'as_' . $method;
# set unique ID for CSS
$graph->id($ID++);
my $t = $graph->nodes() . ' Nodes, ' . $graph->edges . ' Edges';
my $n = $dir."_$file";
$dir = ucfirst($dir);
# get comment
$txt =~ /^\s*#\s*(.*)/;
my $comment = ucfirst($1 || '');
my $link;
$link = $1 if $txt =~ /\n#\s*(http.*)/;
my $name = $comment || $t;
push @toc, [ $n, $name ];
my $out =
"<style type='text/css'>\n" .
"<!--\n" .
$graph->css() .
"-->\n" .
"</style>\n";
if (!$sep)
{
$out .=
"<a name=\"$n\"></a><h2>$dir: $name</h2>\n" .
"<a class='top' href='#top' title='Go to the top'>Top -^</a>\n".
"<div class='text'>\n";
$out .= "<span style='color: red; font-weight: bold;'>Error: </span>" .
$graph->error() if $graph->error();
my $input =
"<div style='float: left;'>\n" .
" <h3>Input</h3>\n" .
" <pre>$txt</pre>\n</div>" .
"<div style='float: left;'>\n" .
" <h3>As Text</h3>\n" .
"<pre>" . $graph->as_txt() . "</pre>\n</div>";
$out .= $input .
"<div style='float: left;'>\n" .
"<h3>As HTML:</h3>\n" .
$graph->$method() . "\n</div>\n";
$out .= "<div class='clear'>&nbsp;</div></div>\n\n";
}
else
{
$out .=
"<a name=\"$n\"></a><h3>$name</h3>\n";
$out .= "<a class='top' href='#top' title='Go to the top'>Top -^</a>\n";
$out .= "<a class='top' href='$link' style='color: red;'>Source</a>\n" if $link;
$out .= "<span style='color: red; font-weight: bold;'>Error: </span> " .
$graph->error() if $graph->error();
$out .= $graph->$method() . "\n" .
"<div class='clear'></div>\n\n";
# write out the input/text
}
$out;
}

72
perl/lib/Graph-Easy-0.76/examples/syntax.tpl Normal file
View File

@@ -0,0 +1,72 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>&lt;graph&gt;-Plugin for Mediawiki - Syntax</title>
<meta name="MSSmartTagsPreventParsing" content="TRUE">
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta http-equiv="imagetoolbar" content="no">
<link rel="stylesheet" type="text/css" href="base.css">
<style type="text/css">
.graph { margin-left: 2em; }
pre { margin-right: 1.5em; }
</style>
</head>
<body bgcolor=white text=black>
<a name="top"></a>
<div class="menu">
<a class="menubck" href="index.html" title="Back to the main page">Main</a>
</div>
<div class="right">
<h1>&lt;graph&gt;-Plugin for Mediawiki</h1>
<h2>##NAME##</h2>
<div class="text">
<p>
This page was automatically created at <strong><small>##time##</small></strong> by <code>examples/syntax.pl</code> running
<a href="http://search.cpan.org/~tels/Graph-Simple/" title="Get it from search.cpan.org">Graph::Easy</a> v##version##.
</p>
<p>
On each of the following testcases you will see the original text
representation of the graph, a text representation created automatically
from the parsed input, as well the automatically generated HTML+CSS code.
</p>
<p>
<strong>Notes:</strong>
</p>
<ul>
<li>The limitations in
<a href="http://search.cpan.org/~tels/Graph-Simple/lib/Graph/Simple.pm#LIMITATIONS">Graph::Easy</a> apply.
</ul>
</div>
<h2>Table of Contents:</h2>
<div class="text">
##TOC##
</div>
##HTML##
<div class="footer">
<p>
This page was automatically created at <strong><small>##time##</small></strong> by <code>examples/syntax.pl</code> running
<a href="http://search.cpan.org/~tels/Graph-Simple/" title="Get it from search.cpan.org">Graph::Easy</a> v##version##.
Contact <a href="/mail.html">Tels</a> for help.
</p>
</div>
</div> <!-- right cell ends here -->
</body></html>

318
perl/lib/Graph-Easy-0.76/examples/wikicrawl.pl Normal file
View File

@@ -0,0 +1,318 @@
#!/usr/bin/perl
use strict;
use Graph::Easy;
use LWP;
use HTML::TokeParser;
use utf8;
use Getopt::Long;
use Encode;
use Data::Dumper;
my $VERSION = 0.03;
# things that shouldn't be looked at
my %bad = map { $_ => 1 } qw/
Wikipedia Image Talk Help Template Portal Special User Category
Wikipedia Bild Diskussion Hilfe Vorlage Portal Spezial Benutzer Kategorie
Wikipédia Image Discuter Modèle Mod%C3%A9le Aide Utilisateur Catégorie Cat%C3%A9gorie
/;
# do not crawl these:
my $skip = qr/\((disambiguation|Begriffsklärung|Homonymie)\)/i;
# to figure out redirections
my $redir = qr/(Weitergeleitet von|Redirected from|Redirig. depuis).*?title="(.*?)"/i;
# the default settings are defined in get_options()
# option handling
my $help_requested = 0; $help_requested = 1 if @ARGV == 0;
my $opt = get_options();
# error?
$help_requested = 1 if !ref($opt);
# no error and --help was specified
$help_requested = 2 if ref($opt) && $opt->{help} ne '';
my $copyright = "wikicrawl v$VERSION (c) by Tels 2008. "
."Released under the GPL 2.0 or later.\n\n"
."After a very cool idea by 'integral' on forum.xkcd.com. Thanx! :)\n\n";
if (ref($opt) && $opt->{version} != 0)
{
print $copyright;
print "Running under Perl v$].\n\n";
exit 2;
}
if ($help_requested > 0)
{
print STDERR $copyright;
require Pod::Usage;
if ($help_requested > 1 && $Pod::Usage::VERSION < 1.35)
{
# The way old Pod::Usage executes "perldoc" might fail:
system('perldoc', $0);
exit 2;
}
Pod::Usage::pod2usage( { -exitval => 2, -verbose => $help_requested } );
}
my $verbose = $opt->{verbose};
output ($copyright);
my $graph = Graph::Easy->new();
# set some default attributes on the graph
$graph->set_attribute('node','shape',$opt->{nodeshape});
$graph->set_attribute('node','font-size','80%');
$graph->set_attribute('edge','arrowstyle','filled');
$graph->set_attribute('graph','label',"Wikipedia map for $opt->{root}");
$graph->set_attribute('graph','font-size', '200%');
$graph->set_attribute('graph','comment', "Created with wikicrawl.pl v$VERSION");
output ("Using the following settings:\n");
print Data::Dumper->Dump([$opt], ['opt']);
# don't crawl stuff twice
my %visitedLinks;
# re-use the UserAgent object
my $ua = LWP::UserAgent->new();
#$ua->agent("WikiCrawl/$VERSION - " . $ua->_agent . " - vGraph::Easy $Graph::Easy::VERSION");
# count how many we have done
my $nodes = 0;
# enable UTF-8 output
binmode STDERR, ':utf8';
binmode STDOUT, ':utf8';
# push the first node on the stack
my @todo = [$opt->{root},0];
# and work on it (this will take one off and then push more nodes on it)
while (@todo && crawl()) { };
my $file = "wikicrawl-$opt->{lang}.txt";
output ("Generating $file:\n");
open(my $DATA, ">", "$file") or die("Could not write to '$file': $!");
binmode ($DATA,':utf8');
print $DATA $graph->as_txt();
close $DATA;
output ("All done.\n");
my $png = $file; $png =~ s/.txt/.png/;
output ("Generating $png:\n");
`perl -Ilib bin/graph-easy --png --renderer=$opt->{renderer} $file`;
output ("All done.\n");
########################################################################################
# main crawl routine
sub crawl {
no warnings 'recursion';
# all done?
return if @todo == 0;
my ($name,$depth) = ($todo[0]->[0],$todo[0]->[1]);
shift @todo;
my $page = "http://$opt->{lang}.wikipedia.org/wiki/$name";
# limit depth
return if $depth + 1 > $opt->{maxdepth};
# already did as many nodes?
return if $opt->{maxnodes} > 0 && $nodes > $opt->{maxnodes};
# skip this page
return 1 if exists $visitedLinks{$page};
# crawl page
my $res = $ua->request(HTTP::Request->new(GET => $page));
return 1 unless $res->is_success();
# remove the " - Wikipedia" (en) or " – Wikipedia" (de) from the title
my $title = decode('utf8',$res->title); # convert to UTF-8
$title =~ s/ [–-] Wikip[ée]dia.*//;
return 1 if $title =~ $skip; # no disambiguation pages
# tels: not sure when/why these happen:
print STDERR "# $title ",$res->title()," $page\n" if $title eq '';
output ("Crawling node #$nodes '$title' at depth $depth\n"); $nodes++;
# set flag
$visitedLinks{$page} = undef;
my $content = $res->content;
# parse anchors
my $parser = HTML::TokeParser->new(\$content) or die("Could not parse page.");
# handle redirects:
$content = decode('utf-8', $content);
$content =~ $redir; my $old = $2;
if ($old)
{
output (" Redirected to '$title' from '$old'\n");
# find the node named "$old" (at the same time adding it if it didn't exist yet)
my $source = $graph->add_node($old);
# and mention the redirect in the label
$source->set_attribute('label', "$old\\n($title)");
# now force edges to come from that node
$title = $old;
}
# iterate over all links
for(my $i = 0; (my $token = $parser->get_tag("a")) && ($i < $opt->{maxspread} || $opt->{maxspread} == 0);)
{
my $url = $token->[1]{href};
my $alt = $token->[1]{title};
next unless defined $url;
# we do not crawl these:
next if $url !~ m/^\/wiki\//; # no pages outside of wikipedia
next if $alt =~ $skip; # no disambiguation pages
next if $alt =~ m/\[/; # no brackets
my @chunks = split ":", substr(decode('utf-8',$url), 6); # extract special pages, if any
next if exists $bad{$chunks[0]}; # no bad pages
$i++;
if ($title ne $alt)
{
output (" Adding link from '$title' to '$alt'\n", 1);
my ($from,$to,$edge) = $graph->add_edge_once($title,$alt);
if (defined $to)
{
my $old_depth = $to->raw_attribute('rank');
if (!$old_depth)
{
my $color = sprintf("%i", (360 / $opt->{maxdepth}) * ($depth));
$to->set_attribute('fill', 'hsl(' .$color.',1,0.7)');
# store rank
$to->set_attribute('rank', $depth+1);
}
}
}
my $u = $url; $u =~ s/^\/wiki\///;
push @todo, [$u,$depth+1];
}
# continue
return 1;
}
sub get_options
{
my $opt = {};
$opt->{help} = '';
$opt->{version} = 0;
# max depth to crawl
$opt->{maxdepth} = 4;
# max number of links per node
$opt->{maxspread} = 5;
# stop after so many nodes, -1 to disable
$opt->{maxnodes} = -1;
# language
$opt->{lang} = 'en';
# root node
$opt->{root} = 'Xkcd';
$opt->{renderer} = 'neato';
$opt->{nodeshape} = 'rect';
my @o = (
"language=s" => \$opt->{lang},
"root=s" => \$opt->{root},
"maxdepth=i" => \$opt->{maxdepth},
"maxspread=i" => \$opt->{maxspread},
"maxnodes=i" => \$opt->{maxnodes},
"version" => \$opt->{version},
"help|?" => \$opt->{help},
"verbose" => \$opt->{verbose},
"nodeshape" => \$opt->{nodeshape},
);
return unless Getopt::Long::GetOptions (@o);
$opt;
}
sub output
{
my ($txt, $level) = @_;
$level |= 0;
print STDERR $txt if $opt->{verbose} || $level == 0;
}
=pod
=head1 NAME
wikicrawl - crawl Wikipedia to generate graph from the found article links
=head1 SYNOPSIS
Crawl wikipedia and create a L<Graph::Easy> text describing the inter-article links
that were found during the crawl.
At least one argument must be given to start:
perl examples/wikicrawl.pl --lang=fr
=head1 ARGUMENTS
Here are the options:
=over 12
=item --help
Print the full documentation, not just this short overview.
=item --version
Write version info and exit.
=item --language
Select the language of Wikipedia that we should crawl. Currently supported
are 'de', 'en' and 'fr'. Default is 'en'.
=item --root
Set the root node where the crawl should start. Default is of course 'Xkcd'.
=item --maxdepth
The maximum depth the crawl should go. Please select small values under 10. Default is 4.
=item --maxspread
The maximum number of links we follow per article. Please select small values under 10. Default is 5.
=item --maxnodes
The maximum number of nodes we crawl. Set to -1 (default) to disable.
=back
=head1 SEE ALSO
L<http://forums.xkcd.com/viewtopic.php?f=2&t=21300&p=672184> and
L<Graph::Easy>.
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the terms of the GPL.
See the LICENSE file of Graph::Easy for a copy of the GPL.
X<license>
=head1 AUTHOR
Copyright (C) 2008 by integral L<forum.xkcd.com>
Copyright (C) 2008 by Tels L<http://bloodgate.com>
=cut

79
perl/lib/Graph-Easy-0.76/inc/Test/Run/Builder.pm Normal file
View File

@@ -0,0 +1,79 @@
package Test::Run::Builder;
use strict;
use warnings;
use Module::Build;
use vars qw(@ISA);
@ISA = (qw(Module::Build));
sub ACTION_runtest
{
my ($self) = @_;
my $p = $self->{properties};
$self->depends_on('code');
local @INC = @INC;
# Make sure we test the module in blib/
unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
File::Spec->catdir($p->{base_dir}, $self->blib, 'arch'));
$self->do_test_run_tests;
}
sub ACTION_distruntest {
my ($self) = @_;
$self->depends_on('distdir');
my $start_dir = $self->cwd;
my $dist_dir = $self->dist_dir;
chdir $dist_dir or die "Cannot chdir to $dist_dir: $!";
# XXX could be different names for scripts
$self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
or die "Error executing 'Build.PL' in dist directory: $!";
$self->run_perl_script('Build')
or die "Error executing 'Build' in dist directory: $!";
$self->run_perl_script('Build', [], ['runtest'])
or die "Error executing 'Build test' in dist directory";
chdir $start_dir;
}
sub do_test_run_tests
{
my $self = shift;
require Test::Run::CmdLine::Iface;
my $test_run =
Test::Run::CmdLine::Iface->new(
{
'test_files' => [glob("t/*.t")],
}
# 'backend_params' => $self->_get_backend_params(),
);
return $test_run->run();
}
sub ACTION_tags
{
my $self = shift;
return
$self->do_system(
"ctags",
qw(-f tags --recurse --totals
--exclude=blib/** --exclude=t/lib/**
--exclude=**/.svn/** --exclude='*~'),
"--exclude=".$self->dist_name()."-*/**",
qw(--languages=Perl --langmap=Perl:+.t)
);
}
1;

4203
perl/lib/Graph-Easy-0.76/lib/Graph/Easy.pm Normal file
View File

File diff suppressed because it is too large Load Diff

1428
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/As_ascii.pm Normal file
View File

File diff suppressed because it is too large Load Diff

396
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/As_graphml.pm Normal file
View File

@@ -0,0 +1,396 @@
#############################################################################
# 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/&/&amp;/g; # quote &
$txt =~ s/>/&gt;/g; # quote >
$txt =~ s/</&lt;/g; # quote <
$txt =~ s/"/&quot;/g; # quote "
$txt =~ s/'/&apos;/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

1249
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/As_graphviz.pm Normal file
View File

File diff suppressed because it is too large Load Diff

487
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/As_txt.pm Normal file
View File

@@ -0,0 +1,487 @@
#############################################################################
# Output an Graph::Easy object as textual description
#
package Graph::Easy::As_txt;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
sub _as_txt
{
my ($self) = @_;
# Convert the graph to a textual representation - does not need layout().
$self->_assign_ranks();
# generate the class attributes first
my $txt = '';
my $att = $self->{att};
for my $class (sort keys %$att)
{
my $out = $self->_remap_attributes(
$class, $att->{$class}, {}, 'noquote', 'encode' );
my $att = '';
for my $atr (sort keys %$out)
{
# border is handled special below
next if $atr =~ /^border/;
$att .= " $atr: $out->{$atr};\n";
}
# edges do not have a border
if ($class !~ /^edge/)
{
my $border = $self->border_attribute($class) || '';
# 'solid 1px #000000' =~ /^solid/;
# 'solid 1px #000000' =~ /^solid 1px #000000/;
$border = '' if $self->default_attribute($class,'border') =~ /^$border/;
$att .= " border: $border;\n" if $border ne '';
}
if ($att ne '')
{
# the following makes short, single definitions to fit on one line
if ($att !~ /\n.*\n/ && length($att) < 40)
{
$att =~ s/\n/ /; $att =~ s/^ / /;
}
else
{
$att = "\n$att";
}
$txt .= "$class {$att}\n";
}
}
$txt .= "\n" if $txt ne ''; # insert newline
my @nodes = $self->sorted_nodes('name','id');
my $count = 0;
# output nodes with attributes first, sorted by their name
foreach my $n (@nodes)
{
$n->{_p} = undef; # mark as not yet processed
my $att = $n->attributes_as_txt();
if ($att ne '')
{
$n->{_p} = 1; # mark as processed
$count++;
$txt .= $n->as_pure_txt() . $att . "\n";
}
}
$txt .= "\n" if $count > 0; # insert a newline
# output groups first, with their nodes
foreach my $gn (sort keys %{$self->{groups}})
{
my $group = $self->{groups}->{$gn};
$txt .= $group->as_txt(); # marks nodes as processed if nec.
$count++;
}
# XXX TODO:
# Output all nodes with rank=0 first, and also follow their successors
# What is left will then be done next, with rank=1 etc.
# This output order let's us output node chains in compact form as:
# [A]->[B]->[C]->[D]
# [B]->[E]
# instead of having:
# [A]->[B]
# [B]->[E]
# [B]->[C] etc
@nodes = $self->sorted_nodes('rank','name');
foreach my $n (@nodes)
{
my @out = $n->sorted_successors();
my $first = $n->as_pure_txt(); # [ A | B ]
if ( defined $n->{autosplit} || ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0)))
{
# single node without any connections (unless already output)
next if exists $n->{autosplit} && !defined $n->{autosplit};
$txt .= $first . "\n" unless defined $n->{_p};
}
$first = $n->_as_part_txt(); # [ A.0 ]
# 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 .= $first . $edge->as_txt() . $other->_as_part_txt() . "\n";
}
}
}
foreach my $n (@nodes)
{
delete $n->{_p}; # clean up
}
$txt;
}
#############################################################################
package Graph::Easy::Group;
use strict;
sub as_txt
{
my $self = shift;
my $n = '';
if (!$self->isa('Graph::Easy::Group::Anon'))
{
$n = $self->{name};
# quote special chars in name
$n =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
$n = ' ' . $n;
}
my $txt = "($n";
$n = $self->{nodes};
$txt .= (keys %$n > 0 ? "\n" : ' ');
for my $name ( sort keys %$n )
{
$n->{$name}->{_p} = 1; # mark as processed
$txt .= ' ' . $n->{$name}->as_pure_txt() . "\n";
}
$txt .= ")" . $self->attributes_as_txt() . "\n\n";
# insert all the edges of the group
#
$txt;
}
#############################################################################
package Graph::Easy::Node;
use strict;
sub attributes_as_txt
{
# return the attributes of this node as text description
my ($self, $remap) = @_;
# nodes that were autosplit
if (exists $self->{autosplit})
{
# other nodes are invisible in as_txt:
return '' unless defined $self->{autosplit};
# the first one might have had a label set
}
my $att = '';
my $class = $self->class();
my $g = $self->{graph};
# XXX TODO: remove atttributes that are simple the default attributes
my $attributes = $self->{att};
if (exists $self->{autosplit})
{
# for the first node in a row of autosplit nodes, we need to create
# the correct attributes, e.g. "silver|red|" instead of just silver:
my $basename = $self->{autosplit_basename};
$attributes = { };
my $parts = $self->{autosplit_parts};
# gather all possible attribute names, otherwise an attribute set
# on only one part (like via "color: |red;" would not show up:
my $names = {};
for my $child ($self, @$parts)
{
for my $k (sort keys %{$child->{att}})
{
$names->{$k} = undef;
}
}
for my $k (sort keys %$names)
{
next if $k eq 'basename';
my $val = $self->{att}->{$k};
$val = '' unless defined $val;
my $first = $val; my $not_equal = 0;
$val .= '|';
for my $child (@$parts)
{
# only consider our own autosplit parts (check should not be nec.)
# next if !exists $child->{autosplit_basename} ||
# $child->{autosplit_basename} ne $basename;
my $v = $child->{att}->{$k}; $v = '' if !defined $v;
$not_equal ++ if $v ne $first;
$val .= $v . '|';
}
# all parts equal, so do "red|red|red" => "red"
$val = $first if $not_equal == 0;
$val =~ s/\|+\z/\|/; # "silver|||" => "silver|"
$val =~ s/\|\z// if $val =~ /\|.*\|/; # "silver|" => "silver|"
# but "red|blue|" => "red|blue"
$attributes->{$k} = $val unless $val eq '|'; # skip '|'
}
$attributes->{basename} = $self->{att}->{basename} if defined $self->{att}->{basename};
}
my $new = $g->_remap_attributes( $self, $attributes, $remap, 'noquote', 'encode' );
# For nodes, we do not output their group attribute, since they simple appear
# at the right place in the txt:
delete $new->{group};
# for groups inside groups, insert their group attribute
$new->{group} = $self->{group}->{name}
if $self->isa('Graph::Easy::Group') && exists $self->{group};
if (defined $self->{origin})
{
$new->{origin} = $self->{origin}->{name};
$new->{offset} = join(',', $self->offset());
}
# shorten output for multi-celled nodes
# for "rows: 2;" still output "rows: 2;", because it is shorter
if (exists $new->{columns})
{
$new->{size} = ($new->{columns}||1) . ',' . ($new->{rows}||1);
delete $new->{rows};
delete $new->{columns};
# don't output the default size
delete $new->{size} if $new->{size} eq '1,1';
}
for my $atr (sort keys %$new)
{
next if $atr =~ /^border/; # handled special
$att .= "$atr: $new->{$atr}; ";
}
if (!$self->isa_cell())
{
my $border;
if (!exists $self->{autosplit})
{
$border = $self->border_attribute();
}
else
{
$border = Graph::Easy::_border_attribute(
$attributes->{borderstyle}||'',
$attributes->{borderwidth}||'',
$attributes->{bordercolor}||'');
}
# XXX TODO: should do this for all attributes, not only for border
# XXX TODO: this seems wrong anyway
# don't include default border
$border = '' if ref $g && $g->attribute($class,'border') eq $border;
$att .= "border: $border; " if $border ne '';
}
# if we have a subclass, we probably need to include it
my $c = '';
$c = $1 if $class =~ /\.(\w+)/;
# but we do not need to include it if our group has a nodeclass attribute
$c = '' if ref($self->{group}) && $self->{group}->attribute('nodeclass') eq $c;
# include our subclass as attribute
$att .= "class: $c; " if $c ne '' && $c ne 'anon';
# generate attribute text if nec.
$att = ' { ' . $att . '}' if $att ne '';
$att;
}
sub _as_part_txt
{
# for edges, we need the name of the part of the first part, not the entire
# autosplit text
my $self = shift;
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]';
}
sub as_pure_txt
{
my $self = shift;
if (exists $self->{autosplit} && defined $self->{autosplit})
{
my $name = $self->{autosplit};
# quote special chars in name (but not |)
$name =~ s/([\[\]\{\}\#])/\\$1/g;
return '[ '. $name .' ]'
}
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]';
}
sub as_txt
{
my $self = shift;
if (exists $self->{autosplit})
{
return '' unless defined $self->{autosplit};
my $name = $self->{autosplit};
# quote special chars in name (but not |)
$name =~ s/([\[\]\{\}\#])/\\$1/g;
return '[ ' . $name . ' ]'
}
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\|\{\}\#])/\\$1/g;
'[ ' . $name . ' ]' . $self->attributes_as_txt();
}
#############################################################################
package Graph::Easy::Edge;
my $styles = {
solid => '--',
dotted => '..',
double => '==',
'double-dash' => '= ',
dashed => '- ',
'dot-dash' => '.-',
'dot-dot-dash' => '..-',
wave => '~~',
};
sub _as_txt
{
my $self = shift;
# '- Name ' or ''
my $n = $self->{att}->{label}; $n = '' unless defined $n;
my $left = ' '; $left = ' <' if $self->{bidirectional};
my $right = '> '; $right = ' ' if $self->{undirected};
my $s = $self->style() || 'solid';
my $style = '--';
# suppress border on edges
my $suppress = { all => { label => undef } };
if ($s =~ /^(bold|bold-dash|broad|wide|invisible)\z/)
{
# output "--> { style: XXX; }"
$style = '--';
}
else
{
# output "-->" or "..>" etc
$suppress->{all}->{style} = undef;
$style = $styles->{ $s };
if (!defined $style)
{
require Carp;
Carp::confess ("Unknown edge style '$s'\n");
}
}
$n = $style . " $n " if $n ne '';
# make " - " into " - - "
$style = $style . $style if $self->{undirected} && substr($style,1,1) eq ' ';
# ' - Name -->' or ' --> ' or ' -- '
my $a = $self->attributes_as_txt($suppress) . ' '; $a =~ s/^\s//;
$left . $n . $style . $right . $a;
}
1;
__END__
=head1 NAME
Graph::Easy::As_txt - Generate textual description from graph object
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
print $graph->as_txt();
# prints something like:
# [ Bonn ] -> [ Berlin ]
=head1 DESCRIPTION
C<Graph::Easy::As_txt> contains just the code for converting a
L<Graph::Easy|Graph::Easy> object to a human-readable textual description.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

586
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/As_vcg.pm Normal file
View File

@@ -0,0 +1,586 @@
#############################################################################
# Output the graph as VCG or GDL text.
#
#############################################################################
package Graph::Easy::As_vcg;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
my $vcg_remap = {
node => {
align => \&_vcg_remap_align,
autolabel => undef,
autolink => undef,
autotitle => undef,
background => undef,
basename => undef,
class => undef,
colorscheme => undef,
columns => undef,
flow => undef,
fontsize => undef,
format => undef,
group => undef,
id => undef,
link => undef,
linkbase => undef,
offset => undef,
origin => undef,
pointstyle => undef,
rank => 'level',
rotate => undef,
rows => undef,
shape => \&_vcg_remap_shape,
size => undef,
textstyle => undef,
textwrap => undef,
title => undef,
},
edge => {
color => 'color', # this entry overrides 'all'!
align => undef,
arrowshape => undef,
arrowstyle => undef,
autojoin => undef,
autolabel => undef,
autolink => undef,
autosplit => undef,
autotitle => undef,
border => undef,
bordercolor => undef,
borderstyle => undef,
borderwidth => undef,
colorscheme => undef,
end => undef,
fontsize => undef,
format => undef,
id => undef,
labelcolor => 'textcolor',
link => undef,
linkbase => undef,
minlen => undef,
start => undef,
# XXX TODO: remap unknown styles
style => 'linestyle',
textstyle => undef,
textwrap => undef,
title => undef,
},
graph => {
align => \&_vcg_remap_align,
flow => \&_vcg_remap_flow,
label => 'title',
type => undef,
},
group => {
},
all => {
background => undef,
color => 'textcolor',
comment => undef,
fill => 'color',
font => 'fontname',
},
always => {
},
# this routine will handle all custom "x-dot-..." attributes
x => \&_remap_custom_vcg_attributes,
};
sub _remap_custom_vcg_attributes
{
my ($self, $name, $value) = @_;
# drop anything that is not starting with "x-vcg-..."
return (undef,undef) unless $name =~ /^x-vcg-/;
$name =~ s/^x-vcg-//; # "x-vcg-foo" => "foo"
($name,$value);
}
my $vcg_shapes = {
rect => 'box',
diamond => 'rhomb',
triangle => 'triangle',
invtriangle => 'triangle',
ellipse => 'ellipse',
circle => 'circle',
hexagon => 'hexagon',
trapezium => 'trapeze',
invtrapezium => 'uptrapeze',
invparallelogram => 'lparallelogram',
parallelogram => 'rparallelogram',
};
sub _vcg_remap_shape
{
my ($self, $name, $shape) = @_;
return ('invisible','yes') if $shape eq 'invisible';
('shape', $vcg_shapes->{$shape} || 'box');
}
sub _vcg_remap_align
{
my ($self, $name, $style) = @_;
# center => center, left => left_justify, right => right_justify
$style .= '_justify' unless $style eq 'center';
('textmode', $style);
}
my $vcg_flow = {
'south' => 'top_to_bottom',
'north' => 'bottom_to_top',
'down' => 'top_to_bottom',
'up' => 'bottom_to_top',
'east' => 'left_to_right',
'west' => 'right_to_left',
'right' => 'left_to_right',
'left' => 'right_to_left',
};
sub _vcg_remap_flow
{
my ($self, $name, $style) = @_;
('orientation', $vcg_flow->{$style} || 'top_to_bottom');
}
sub _class_attributes_as_vcg
{
# convert a hash with attribute => value mappings to a string
my ($self, $a, $class) = @_;
my $att = '';
$class = '' if $class eq 'graph';
$class .= '.' if $class ne '';
# create the attributes as text:
for my $atr (sort keys %$a)
{
my $v = $a->{$atr};
$v =~ s/"/\\"/g; # '2"' => '2\"'
$v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/; # 1, "1a"
$att .= " $class$atr: $v\n";
}
$att =~ s/,\s$//; # remove last ","
$att = "\n$att" unless $att eq '';
$att;
}
#############################################################################
sub _generate_vcg_edge
{
# Given an edge, generate the VCG code for it
my ($self, $e, $indent) = @_;
# skip links from/to groups, these will be done later
return '' if
$e->{from}->isa('Graph::Easy::Group') ||
$e->{to}->isa('Graph::Easy::Group');
my $edge_att = $e->attributes_as_vcg();
$e->{_p} = undef; # mark as processed
" edge:$edge_att\n"; # return edge text
}
use Graph::Easy::Util qw(ord_values);
sub _as_vcg
{
my ($self) = @_;
# convert the graph to a textual representation
# does not need a layout() beforehand!
# gather all edge classes to build the classname attribute from them:
$self->{_vcg_edge_classes} = {};
for my $e (ord_values ( $self->{edges} ))
{
my $class = $e->sub_class();
$self->{_vcg_edge_classes}->{$class} = undef if defined $class && $class ne '';
}
# sort gathered class names and map them to integers
my $class_names = '';
if (keys %{$self->{_vcg_edge_classes}} > 0)
{
my $i = 1;
$class_names = "\n";
for my $ec (sort keys %{$self->{_vcg_edge_classes}})
{
$self->{_vcg_edge_classes}->{$ec} = $i; # remember mapping
$class_names .= " classname $i: \"$ec\"\n";
$i++;
}
}
# generate the class attributes first
my $label = $self->label();
my $t = ''; $t = "\n title: \"$label\"" if $label ne '';
my $txt = "graph: {$t\n\n" .
" // Generated by Graph::Easy $Graph::Easy::VERSION" .
" at " . scalar localtime() . "\n" .
$class_names;
my $groups = $self->groups();
# to keep track of invisible helper nodes
$self->{_vcg_invis} = {};
# name for invisible helper nodes
$self->{_vcg_invis_id} = 'joint0';
my $atts = $self->{att};
# insert the class attributes
for my $class (qw/edge graph node/)
{
next if $class =~ /\./; # skip subclasses
my $out = $self->_remap_attributes( $class, $atts->{$class}, $vcg_remap, 'noquote');
$txt .= $self->_class_attributes_as_vcg($out, $class);
}
$txt .= "\n" if $txt ne ''; # insert newline
###########################################################################
# output groups as subgraphs
# insert the edges into the proper group
$self->_edges_into_groups() if $groups > 0;
# output the groups (aka subclusters)
my $indent = ' ';
for my $group (sort { $a->{name} cmp $b->{name} } values %{$self->{groups}})
{
# quote special chars in group name
my $name = $group->{name}; $name =~ s/([\[\]\(\)\{\}\#"])/\\$1/g;
# # output group attributes first
# $txt .= " subgraph \"cluster$group->{id}\" {\n${indent}label=\"$name\";\n";
# Make a copy of the attributes, including our class attributes:
my $copy = {};
my $attribs = $group->get_attributes();
for my $a (keys %$attribs)
{
$copy->{$a} = $attribs->{$a};
}
# # set some defaults
# $copy->{'borderstyle'} = 'solid' unless defined $copy->{'borderstyle'};
my $out = {};
# my $out = $self->_remap_attributes( $group->class(), $copy, $vcg_remap, 'noquote');
# Set some defaults:
$out->{fillcolor} = '#a0d0ff' unless defined $out->{fillcolor};
# $out->{labeljust} = 'l' unless defined $out->{labeljust};
my $att = '';
# we need to output style first ("filled" and "color" need come later)
for my $atr (reverse sort keys %$out)
{
my $v = $out->{$atr};
$v = '"' . $v . '"';
$att .= " $atr: $v\n";
}
$txt .= $att . "\n" if $att ne '';
# # output nodes (w/ or w/o attributes) in that group
# for my $n ($group->sorted_nodes())
# {
# my $att = $n->attributes_as_vcg();
# $n->{_p} = undef; # mark as processed
# $txt .= $indent . $n->as_graphviz_txt() . $att . "\n";
# }
# # output node connections in this group
# for my $e (ord_values ( $group->{edges} ))
# {
# next if exists $e->{_p};
# $txt .= $self->_generate_edge($e, $indent);
# }
$txt .= " }\n";
}
my $root = $self->attribute('root');
$root = '' unless defined $root;
my $count = 0;
# output nodes with attributes first, sorted by their name
for my $n (sort { $a->{name} cmp $b->{name} } values %{$self->{nodes}})
{
next if exists $n->{_p};
my $att = $n->attributes_as_vcg($root);
if ($att ne '')
{
$n->{_p} = undef; # mark as processed
$count++;
$txt .= " node:" . $att . "\n";
}
}
$txt .= "\n" if $count > 0; # insert a newline
my @nodes = $self->sorted_nodes();
foreach my $n (@nodes)
{
my @out = $n->successors();
my $first = $n->as_vcg_txt();
if ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0))
{
# single node without any connections (unless already output)
$txt .= " node: { title: " . $first . " }\n" unless exists $n->{_p};
}
# for all outgoing connections
foreach my $other (reverse @out)
{
# in case there is more than one edge going from N to O
my @edges = $n->edges_to($other);
foreach my $e (@edges)
{
next if exists $e->{_p};
$txt .= $self->_generate_vcg_edge($e, ' ');
}
}
}
# insert now edges between groups (clusters/subgraphs)
# foreach my $e (ord_values ( $self->{edges} ))
# {
# $txt .= $self->_generate_group_edge($e, ' ')
# if $e->{from}->isa('Graph::Easy::Group') ||
# $e->{to}->isa('Graph::Easy::Group');
# }
# clean up
for my $n ( ord_values ( $self->{nodes} ), ord_values ( $self->{edges} ))
{
delete $n->{_p};
}
delete $self->{_vcg_invis}; # invisible helper nodes for joints
delete $self->{_vcg_invis_id}; # invisible helper node name
delete $self->{_vcg_edge_classes};
$txt . "\n}\n"; # close the graph
}
package Graph::Easy::Node;
sub attributes_as_vcg
{
# return the attributes of this node as text description
my ($self, $root) = @_;
$root = '' unless defined $root;
my $att = '';
my $class = $self->class();
return '' unless ref $self->{graph};
my $g = $self->{graph};
# get all attributes, excluding the class attributes
my $a = $self->raw_attributes();
# add the attributes that are listed under "always":
my $attr = $self->{att};
my $base_class = $class; $base_class =~ s/\..*//;
my $list = $vcg_remap->{always}->{$class} || $vcg_remap->{always}->{$base_class};
for my $name (@$list)
{
# for speed, try to look it up directly
# look if we have a code ref, if yes, simple set the value to undef
# and let the coderef handle it later:
if ( ref($vcg_remap->{$base_class}->{$name}) ||
ref($vcg_remap->{all}->{$name}) )
{
$a->{$name} = $attr->{$name};
}
else
{
$a->{$name} = $attr->{$name};
$a->{$name} = $self->attribute($name) unless defined $a->{$name} && $a->{$name} ne 'inherit';
}
}
$a = $g->_remap_attributes( $self, $a, $vcg_remap, 'noquote');
if ($self->isa('Graph::Easy::Edge'))
{
$a->{sourcename} = $self->{from}->{name};
$a->{targetname} = $self->{to}->{name};
my $class = $self->sub_class();
$a->{class} = $self->{graph}->{_vcg_edge_classes}->{ $class } if defined $class && $class ne '';
}
else
{
# title: "Bonn"
$a->{title} = $self->{name};
}
# do not needlessly output labels:
delete $a->{label} if !$self->isa('Graph::Easy::Edge') && # not an edge
exists $a->{label} && $a->{label} eq $self->{name};
# bidirectional and undirected edges
if ($self->{bidirectional})
{
delete $a->{dir};
my ($n,$s) = Graph::Easy::_graphviz_remap_arrow_style(
$self,'', $self->attribute('arrowstyle'));
$a->{arrowhead} = $s;
$a->{arrowtail} = $s;
}
if ($self->{undirected})
{
delete $a->{dir};
$a->{arrowhead} = 'none';
$a->{arrowtail} = 'none';
}
# borderstyle: double:
if (!$self->isa('Graph::Easy::Edge'))
{
my $style = $self->attribute('borderstyle');
$a->{peripheries} = 2 if $style =~ /^double/;
}
# For nodes with shape plaintext, set the fillcolor to the background of
# the graph/group
my $shape = $a->{shape} || 'rect';
if ($class =~ /node/ && $shape eq 'plaintext')
{
my $p = $self->parent();
$a->{fillcolor} = $p->attribute('fill');
$a->{fillcolor} = 'white' if $a->{fillcolor} eq 'inherit';
}
$shape = $self->attribute('shape') unless $self->isa_cell();
# for point-shaped nodes, include the point as label and set width/height
if ($shape eq 'point')
{
require Graph::Easy::As_ascii; # for _u8 and point-style
my $style = $self->_point_style( $self->attribute('pointstyle') );
$a->{label} = $style;
# for point-shaped invisible nodes, set height/width = 0
$a->{width} = 0, $a->{height} = 0 if $style eq '';
}
if ($shape eq 'invisible')
{
$a->{label} = ' ';
}
$a->{rank} = '0' if $root ne '' && $root eq $self->{name};
# create the attributes as text:
for my $atr (sort keys %$a)
{
my $v = $a->{$atr};
$v =~ s/"/\\"/g; # '2"' => '2\"'
$v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/; # 1, "1a"
$att .= "$atr: $v ";
}
$att =~ s/,\s$//; # remove last ","
# generate attribute text if nec.
$att = ' { ' . $att . '}' if $att ne '';
$att;
}
sub as_vcg_txt
{
# return the node itself (w/o attributes) as VCG representation
my $self = shift;
my $name = $self->{name};
# escape special chars in name (including doublequote!)
$name =~ s/([\[\]\(\)\{\}"])/\\$1/g;
# quote:
'"' . $name . '"';
}
1;
__END__
=head1 NAME
Graph::Easy::As_vcg - Generate VCG/GDL text from Graph::Easy object
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
print $graph->as_vcg();
This prints something like this:
graph: {
node: { title: "Bonn" }
node: { title: "Berlin" }
edge: { sourcename: "Bonn" targetname: "Berlin" }
}
=head1 DESCRIPTION
C<Graph::Easy::As_vcg> contains just the code for converting a
L<Graph::Easy|Graph::Easy> object to either a VCG
or GDL textual description.
Note that the generated format is compatible to C<GDL> aka I<Graph
Description Language>.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>, L<http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html>.
=head1 AUTHOR
Copyright (C) 2004-2008 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

4182
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Attributes.pm Normal file
View File

File diff suppressed because it is too large Load Diff

486
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Base.pm Normal file
View File

@@ -0,0 +1,486 @@
#############################################################################
# A baseclass for Graph::Easy objects like nodes, edges etc.
#
#############################################################################
package Graph::Easy::Base;
$VERSION = '0.76';
use strict;
use warnings;
#############################################################################
{
# protected vars
my $id = 0;
sub _new_id { $id++; }
sub _reset_id { $id = 0; }
}
#############################################################################
sub new
{
# Create a new object. This is a generic routine that is inherited
# by many other things like Edge, Cell etc.
my $self = bless { id => _new_id() }, shift;
my $args = $_[0];
$args = { name => $_[0] } if ref($args) ne 'HASH' && @_ == 1;
$args = { @_ } if ref($args) ne 'HASH' && @_ > 1;
$self->_init($args);
}
sub _init
{
# Generic init routine, to be overriden in subclasses.
my ($self,$args) = @_;
$self;
}
sub self
{
my $self = shift;
$self;
}
#############################################################################
sub no_fatal_errors
{
my $self = shift;
$self->{fatal_errors} = ($_[1] ? 1 : 0) if @_ > 0;
~ ($self->{fatal_errors} || 0);
}
sub fatal_errors
{
my $self = shift;
$self->{fatal_errors} = ($_[1] ? 0 : 1) if @_ > 0;
$self->{fatal_errors} || 0;
}
sub error
{
my $self = shift;
# If we switched to a temp. Graphviz parser, then set the error on the
# original parser object, too:
$self->{_old_self}->error(@_) if ref($self->{_old_self});
# if called on a member on a graph, call error() on the graph itself:
return $self->{graph}->error(@_) if ref($self->{graph});
if (defined $_[0])
{
$self->{error} = $_[0];
if ($self->{_catch_errors})
{
push @{$self->{_errors}}, $self->{error};
}
else
{
$self->_croak($self->{error}, 2)
if ($self->{fatal_errors}) && $self->{error} ne '';
}
}
$self->{error} || '';
}
sub error_as_html
{
# return error() properly escaped
my $self = shift;
my $msg = $self->{error};
$msg =~ s/&/&amp;/g;
$msg =~ s/</&lt;/g;
$msg =~ s/>/&gt;/g;
$msg =~ s/"/&quot;/g;
$msg;
}
sub catch_messages
{
# Catch all warnings (and errors if no_fatal_errors() was used)
# these can later be retrieved with warnings() and errors():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_warnings} = 1;
$self->{_catch_errors} = 1;
$self->{_warnings} = [];
$self->{_errors} = [];
}
else
{
$self->{_catch_warnings} = 0;
$self->{_catch_errors} = 0;
}
}
$self;
}
sub catch_warnings
{
# Catch all warnings
# these can later be retrieved with warnings():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_warnings} = 1;
$self->{_warnings} = [];
}
else
{
$self->{_catch_warnings} = 0;
}
}
$self->{_catch_warnings};
}
sub catch_errors
{
# Catch all errors
# these can later be retrieved with errors():
my $self = shift;
if (@_ > 0)
{
if ($_[0])
{
$self->{_catch_errors} = 1;
$self->{_errors} = [];
}
else
{
$self->{_catch_errors} = 0;
}
}
$self->{_catch_errors};
}
sub warnings
{
# return all warnings that occurred after catch_messages(1)
my $self = shift;
@{$self->{_warnings}};
}
sub errors
{
# return all errors that occurred after catch_messages(1)
my $self = shift;
@{$self->{_errors}};
}
sub warn
{
my ($self, $msg) = @_;
if ($self->{_catch_warnings})
{
push @{$self->{_warnings}}, $msg;
}
else
{
require Carp;
Carp::carp('Warning: ' . $msg);
}
}
sub _croak
{
my ($self, $msg, $level) = @_;
$level = 1 unless defined $level;
require Carp;
if (ref($self) && $self->{debug})
{
$Carp::CarpLevel = $level; # don't report Base itself
Carp::confess($msg);
}
else
{
Carp::croak($msg);
}
}
#############################################################################
# class management
sub sub_class
{
# get/set the subclass
my $self = shift;
if (defined $_[0])
{
$self->{class} =~ s/\..*//; # nix subclass
$self->{class} .= '.' . $_[0]; # append new one
delete $self->{cache};
$self->{cache}->{subclass} = $_[0];
$self->{cache}->{class} = $self->{class};
return;
}
$self->{class} =~ /\.(.*)/;
return $1 if defined $1;
return $self->{cache}->{subclass} if defined $self->{cache}->{subclass};
# Subclass not defined, so check our base class for a possible set class
# attribute and return this:
# take a shortcut
my $g = $self->{graph};
if (defined $g)
{
my $subclass = $g->{att}->{$self->{class}}->{class};
$subclass = '' unless defined $subclass;
$self->{cache}->{subclass} = $subclass;
$self->{cache}->{class} = $self->{class};
return $subclass;
}
# not part of a graph?
$self->{cache}->{subclass} = $self->attribute('class');
}
sub class
{
# return our full class name like "node.subclass" or "node"
my $self = shift;
$self->error("class() method does not take arguments") if @_ > 0;
$self->{class} =~ /\.(.*)/;
return $self->{class} if defined $1;
return $self->{cache}->{class} if defined $self->{cache}->{class};
# Subclass not defined, so check our base class for a possible set class
# attribute and return this:
my $subclass;
# take a shortcut:
my $g = $self->{graph};
if (defined $g)
{
$subclass = $g->{att}->{$self->{class}}->{class};
$subclass = '' unless defined $subclass;
}
$subclass = $self->{att}->{class} unless defined $subclass;
$subclass = '' unless defined $subclass;
$self->{cache}->{subclass} = $subclass;
$subclass = '.' . $subclass if $subclass ne '';
$self->{cache}->{class} = $self->{class} . $subclass;
}
sub main_class
{
my $self = shift;
$self->{class} =~ /^(.+?)(\.|\z)/; # extract first part
$1;
}
1;
__END__
=head1 NAME
Graph::Easy::Base - base class for Graph::Easy objects like nodes, edges etc
=head1 SYNOPSIS
package Graph::Easy::My::Node;
use Graph::Easy::Base;
@ISA = qw/Graph::Easy::Base/;
=head1 DESCRIPTION
Used automatically and internally by L<Graph::Easy> - should not be used
directly.
=head1 METHODS
=head2 new()
my $object = Graph::Easy::Base->new();
Create a new object, and call C<_init()> on it.
=head2 error()
$last_error = $object->error();
$object->error($error); # set new messages
$object->error(''); # clear the error
Returns the last error message, or '' for no error.
When setting a new error message, C<< $self->_croak($error) >> will be called
unless C<< $object->no_fatal_errors() >> is true.
=head2 error_as_html()
my $error = $object->error_as_html();
Returns the same error message as L<error()>, but properly escaped
as HTML so it is safe to output to the client.
=head2 warn()
$object->warn('Warning!');
Warn on STDERR with the given message.
=head2 no_fatal_errors()
$object->no_fatal_errors(1);
Set the flag that determines whether setting an error message
via C<error()> is fatal, e.g. results in a call to C<_croak()>.
A true value will make errors non-fatal. See also L<fatal_errors>.
=head2 fatal_errors()
$fatal = $object->fatal_errors();
$object->fatal_errors(0); # turn off
$object->fatal_errors(1); # turn on
Set/get the flag that determines whether setting an error message
via C<error()> is fatal, e.g. results in a call to C<_croak()>.
A true value makes errors fatal.
=head2 catch_errors()
my $catch_errors = $object->catch_errors(); # query
$object->catch_errors(1); # enable
$object->...(); # some error
if ($object->error())
{
my @errors = $object->errors(); # retrieve
}
Enable/disable catching of all error messages. When enabled,
all previously caught error messages are thrown away, and from this
poin on new errors are non-fatal and stored internally. You can
retrieve these errors later with the errors() method.
=head2 catch_warnings()
my $catch_warns = $object->catch_warnings(); # query
$object->catch_warnings(1); # enable
$object->...(); # some error
if ($object->warning())
{
my @warnings = $object->warnings(); # retrieve
}
Enable/disable catching of all warnings. When enabled, all previously
caught warning messages are thrown away, and from this poin on new
warnings are stored internally. You can retrieve these errors later
with the errors() method.
=head2 catch_messages()
# catch errors and warnings
$object->catch_messages(1);
# stop catching errors and warnings
$object->catch_messages(0);
A true parameter is equivalent to:
$object->catch_warnings(1);
$object->catch_errors(1);
See also: L<catch_warnings()> and L<catch_errors()> as well as
L<errors()> and L<warnings()>.
=head2 errors()
my @errors = $object->errors();
Return all error messages that occurred after L<catch_messages()> was
called.
=head2 warnings()
my @warnings = $object->warnings();
Return all warning messages that occurred after L<catch_messages()>
or L<catch_errors()> was called.
=head2 self()
my $self = $object->self();
Returns the object itself.
=head2 class()
my $class = $object->class();
Returns the full class name like C<node.cities>. See also C<sub_class>.
=head2 sub_class()
my $sub_class = $object->sub_class();
Returns the sub class name like C<cities>. See also C<class>.
=head2 main_class()
my $main_class = $object->main_class();
Returns the main class name like C<node>. See also C<sub_class>.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
X<tels>
X<bloodgate>
X<license>
X<gpl>
=cut

751
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Edge.pm Normal file
View File

@@ -0,0 +1,751 @@
#############################################################################
# An edge connecting two nodes in Graph::Easy.
#
#############################################################################
package Graph::Easy::Edge;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/; # an edge is just a special node
$VERSION = '0.76';
use strict;
use warnings;
use constant isa_cell => 1;
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = 'edge';
# leave this unitialized until we need it
# $self->{cells} = [ ];
foreach my $k (sort keys %$args)
{
if ($k !~ /^(label|name|style)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
}
my $n = $k; $n = 'label' if $k eq 'name';
$self->{att}->{$n} = $args->{$k};
}
$self;
}
#############################################################################
# accessor methods
sub bidirectional
{
my $self = shift;
if (@_ > 0)
{
my $old = $self->{bidirectional} || 0;
$self->{bidirectional} = $_[0] ? 1 : 0;
# invalidate layout?
$self->{graph}->{score} = undef if $old != $self->{bidirectional} && ref($self->{graph});
}
$self->{bidirectional};
}
sub undirected
{
my $self = shift;
if (@_ > 0)
{
my $old = $self->{undirected} || 0;
$self->{undirected} = $_[0] ? 1 : 0;
# invalidate layout?
$self->{graph}->{score} = undef if $old != $self->{undirected} && ref($self->{graph});
}
$self->{undirected};
}
sub has_ports
{
my $self = shift;
my $s_port = $self->{att}->{start} || $self->attribute('start');
return 1 if $s_port ne '';
my $e_port = $self->{att}->{end} || $self->attribute('end');
return 1 if $e_port ne '';
0;
}
sub start_port
{
# return the side and portnumber if the edge has a shared source port
# undef for none
my $self = shift;
my $s = $self->{att}->{start} || $self->attribute('start');
return undef if !defined $s || $s !~ /,/; # "south, 0" => ok, "south" => no
return (split /\s*,\s*/, $s) if wantarray;
$s =~ s/\s+//g; # remove spaces to normalize "south, 0" to "south,0"
$s;
}
sub end_port
{
# return the side and portnumber if the edge has a shared source port
# undef for none
my $self = shift;
my $s = $self->{att}->{end} || $self->attribute('end');
return undef if !defined $s || $s !~ /,/; # "south, 0" => ok, "south" => no
return split /\s*,\s*/, $s if wantarray;
$s =~ s/\s+//g; # remove spaces to normalize "south, 0" to "south,0"
$s;
}
sub style
{
my $self = shift;
$self->{att}->{style} || $self->attribute('style');
}
sub name
{
# returns actually the label
my $self = shift;
$self->{att}->{label} || '';
}
#############################################################################
# cell management - used by the cell-based layouter
sub _cells
{
# return all the cells this edge currently occupies
my $self = shift;
$self->{cells} = [] unless defined $self->{cells};
@{$self->{cells}};
}
sub _clear_cells
{
# remove all belonging cells
my $self = shift;
$self->{cells} = [];
$self;
}
sub _unplace
{
# Take an edge, and remove all the cells it covers from the cells area
my ($self, $cells) = @_;
print STDERR "# clearing path from $self->{from}->{name} to $self->{to}->{name}\n" if $self->{debug};
for my $key (@{$self->{cells}})
{
# XXX TODO: handle crossed edges differently (from CROSS => HOR or VER)
# free in our cells area
delete $cells->{$key};
}
$self->clear_cells();
$self;
}
sub _distance
{
# estimate the distance from SRC to DST node
my ($self) = @_;
my $src = $self->{from};
my $dst = $self->{to};
# one of them not yet placed?
return 100000 unless defined $src->{x} && defined $dst->{x};
my $cells = $self->{graph}->{cells};
# get all the starting positions
# distance = 1: slots, generate starting types, the direction is shifted
# by 90° counter-clockwise
my @start = $src->_near_places($cells, 1, undef, undef, $src->_shift(-90) );
# potential stop positions
my @stop = $dst->_near_places($cells, 1); # distance = 1: slots
my ($s_p,@ss_p) = $self->port('start');
my ($e_p,@ee_p) = $self->port('end');
# the edge has a port description, limiting the start places
@start = $src->_allowed_places( \@start, $src->_allow( $s_p, @ss_p ), 3)
if defined $s_p;
# the edge has a port description, limiting the stop places
@stop = $dst->_allowed_places( \@stop, $dst->_allow( $e_p, @ee_p ), 3)
if defined $e_p;
my $stop = scalar @stop;
return 0 unless @stop > 0 && @start > 0; # no free slots on one node?
my $lowest;
my $i = 0;
while ($i < scalar @start)
{
my $sx = $start[$i]; my $sy = $start[$i+1]; $i += 2;
# for each start point, calculate the distance to each stop point, then use
# the smallest as value
for (my $u = 0; $u < $stop; $u += 2)
{
my $dist = Graph::Easy::_astar_distance($sx,$sy, $stop[$u], $stop[$u+1]);
$lowest = $dist if !defined $lowest || $dist < $lowest;
}
}
$lowest;
}
sub _add_cell
{
# add a cell to the list of cells this edge covers. If $after is a ref
# to a cell, then the new cell will be inserted right after this cell.
# if after is defined, but not a ref, the new cell will be inserted
# at the specified position.
my ($self, $cell, $after, $before) = @_;
$self->{cells} = [] unless defined $self->{cells};
my $cells = $self->{cells};
# if both are defined, but belong to different edges, just ignore $before:
$before = undef if ref($before) && $before->{edge} != $self;
$after = undef if ref($after) && $after->{edge} != $self;
if (!defined $after && ref($before))
{
$after = $before; $before = undef;
}
if (defined $after)
{
# insert the new cell right after $after
my $ofs = $after;
if (ref($after) && !ref($before))
{
# insert after $after
$ofs = 1;
for my $cell (@$cells)
{
last if $cell == $after;
$ofs++;
}
}
elsif (ref($after) && ref($before))
{
# insert between after and before (or before/after for "reversed edges)
$ofs = 0;
my $found = 0;
while ($ofs < scalar @$cells - 1) # 0,1,2,3 => 0 .. 2
{
my $c1 = $cells->[$ofs];
my $c2 = $cells->[$ofs+1];
$ofs++;
$found++, last if (($c1 == $after && $c2 == $before) ||
($c1 == $before && $c2 == $after));
}
if (!$found)
{
# XXX TODO: last effort
# insert after $after
$ofs = 1;
for my $cell (@$cells)
{
last if $cell == $after;
$ofs++;
}
$found++;
}
$self->_croak("Could not find $after and $before") unless $found;
}
splice (@$cells, $ofs, 0, $cell);
}
else
{
# insert new cell at the end
push @$cells, $cell;
}
$cell->_update_boundaries();
$self;
}
#############################################################################
sub from
{
my $self = shift;
$self->{from};
}
sub to
{
my $self = shift;
$self->{to};
}
sub nodes
{
my $self = shift;
($self->{from}, $self->{to});
}
sub start_at
{
# move the edge's start point from the current node to the given node
my ($self, $node) = @_;
# if not a node yet, or not part of this graph, make into one proper node
$node = $self->{graph}->add_node($node);
$self->_croak("start_at() needs a node object, but got $node")
unless ref($node) && $node->isa('Graph::Easy::Node');
# A => A => nothing to do
return $node if $self->{from} == $node;
# delete self at A
delete $self->{from}->{edges}->{ $self->{id} };
# set "from" to B
$self->{from} = $node;
# add to B
$self->{from}->{edges}->{ $self->{id} } = $self;
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
# return new start point
$node;
}
sub end_at
{
# move the edge's end point from the current node to the given node
my ($self, $node) = @_;
# if not a node yet, or not part of this graph, make into one proper node
$node = $self->{graph}->add_node($node);
$self->_croak("start_at() needs a node object, but got $node")
unless ref($node) && $node->isa('Graph::Easy::Node');
# A => A => nothing to do
return $node if $self->{to} == $node;
# delete self at A
delete $self->{to}->{edges}->{ $self->{id} };
# set "to" to B
$self->{to} = $node;
# add to node B
$self->{to}->{edges}->{ $self->{id} } = $self;
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
# return new end point
$node;
}
sub edge_flow
{
# return the flow at this edge or '' if the edge itself doesn't have a flow
my $self = shift;
# our flow comes from ourselves
my $flow = $self->{att}->{flow};
$flow = $self->raw_attribute('flow') unless defined $flow;
$flow;
}
sub flow
{
# return the flow at this edge (including inheriting flow from node)
my ($self) = @_;
# print STDERR "# flow from $self->{from}->{name} to $self->{to}->{name}\n";
# our flow comes from ourselves
my $flow = $self->{att}->{flow};
# or maybe our class
$flow = $self->raw_attribute('flow') unless defined $flow;
# if the edge doesn't have a flow, maybe the node has a default out flow
$flow = $self->{from}->{att}->{flow} if !defined $flow;
# if that didn't work out either, use the parents flows
$flow = $self->parent()->attribute('flow') if !defined $flow;
# or finally, the default "east":
$flow = 90 if !defined $flow;
# absolute flow does not depend on the in-flow, so can return early
return $flow if $flow =~ /^(0|90|180|270)\z/;
# in-flow comes from our "from" node
my $in = $self->{from}->flow();
# print STDERR "# in: $self->{from}->{name} = $in\n";
my $out = $self->{graph}->_flow_as_direction($in,$flow);
$out;
}
sub port
{
my ($self, $which) = @_;
$self->_croak("'$which' must be one of 'start' or 'end' in port()") unless $which =~ /^(start|end)/;
# our flow comes from ourselves
my $sp = $self->attribute($which);
return (undef,undef) unless defined $sp && $sp ne '';
my ($side, $port) = split /\s*,\s*/, $sp;
# if absolut direction, return as is
my $s = Graph::Easy->_direction_as_side($side);
if (defined $s)
{
my @rc = ($s); push @rc, $port if defined $port;
return @rc;
}
# in_flow comes from our "from" node
my $in = 90; $in = $self->{from}->flow() if ref($self->{from});
# turn left in "south" etc:
$s = Graph::Easy->_flow_as_side($in,$side);
my @rc = ($s); push @rc, $port if defined $port;
@rc;
}
sub flip
{
# swap from and to for this edge
my ($self) = @_;
($self->{from}, $self->{to}) = ($self->{to}, $self->{from});
# invalidate layout
$self->{graph}->{score} = undef if ref($self->{graph});
$self;
}
sub as_ascii
{
my ($self, $x,$y) = @_;
# invisible nodes, or very small ones
return '' if $self->{w} == 0 || $self->{h} == 0;
my $fb = $self->_framebuffer($self->{w}, $self->{h});
###########################################################################
# "draw" the label into the framebuffer (e.g. the edge and the text)
$self->_draw_label($fb, $x, $y, '');
join ("\n", @$fb);
}
sub as_txt
{
require Graph::Easy::As_ascii;
_as_txt(@_);
}
1;
__END__
=head1 NAME
Graph::Easy::Edge - An edge (a path connecting one ore more nodes)
=head1 SYNOPSIS
use Graph::Easy;
my $ssl = Graph::Easy::Edge->new(
label => 'encrypted connection',
style => 'solid',
);
$ssl->set_attribute('color', 'red');
my $src = Graph::Easy::Node->new('source');
my $dst = Graph::Easy::Node->new('destination');
$graph = Graph::Easy->new();
$graph->add_edge($src, $dst, $ssl);
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Edge> represents an edge between two (or more) nodes in a
simple graph.
Each edge has a direction (from source to destination, or back and forth),
plus a style (line width and style), colors etc. It can also have a label,
e.g. a text associated with it.
During the layout phase, each edge also contains a list of path-elements
(also called cells), which make up the path from source to destination.
=head1 METHODS
=head2 error()
$last_error = $edge->error();
$cvt->error($error); # set new messages
$cvt->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $edge->as_ascii();
Returns the edge as a little ascii representation.
=head2 as_txt()
my $txt = $edge->as_txt();
Returns the edge as a little Graph::Easy textual representation.
=head2 label()
my $label = $edge->label();
Returns the label (also known as 'name') of the edge.
=head2 name()
my $label = $edge->name();
To make the interface more consistent, the C<name()> method of
an edge can also be called, and it will returned either the edge
label, or the empty string if the edge doesn't have a label.
=head2 style()
my $style = $edge->style();
Returns the style of the edge, like 'solid', 'dotted', 'double', etc.
=head2 nodes()
my @nodes = $edge->nodes();
Returns the source and target node that this edges connects as objects.
=head2 bidirectional()
$edge->bidirectional(1);
if ($edge->bidirectional())
{
}
Returns true if the edge is bidirectional, aka has arrow heads on both ends.
An optional parameter will set the bidirectional status of the edge.
=head2 undirected()
$edge->undirected(1);
if ($edge->undirected())
{
}
Returns true if the edge is undirected, aka has now arrow at all.
An optional parameter will set the undirected status of the edge.
=head2 has_ports()
if ($edge->has_ports())
{
...
}
Return true if the edge has restriction on the starting or ending
port, e.g. either the C<start> or C<end> attribute is set on
this edge.
=head2 start_port()
my $port = $edge->start_port();
Return undef if the edge does not have a fixed start port, otherwise
returns the port as "side, number", for example "south, 0".
=head2 end_port()
my $port = $edge->end_port();
Return undef if the edge does not have a fixed end port, otherwise
returns the port as "side, number", for example "south, 0".
=head2 from()
my $from = $edge->from();
Returns the node that this edge starts at. See also C<to()>.
=head2 to()
my $to = $edge->to();
Returns the node that this edge leads to. See also C<from()>.
=head2 start_at()
$edge->start_at($other);
my $other = $edge->start_at('some node');
Set the edge's start point to the given node. If given a node name,
will add that node to the graph first.
Returns the new edge start point node.
=head2 end_at()
$edge->end_at($other);
my $other = $edge->end_at('some other node');
Set the edge's end point to the given node. If given a node name,
will add that node to the graph first.
Returns the new edge end point node.
=head2 flip()
$edge->flip();
Swaps the C<start> and C<end> nodes on this edge, e.g. reverses the direction
of the edge.
X<transpose>
=head2 flow()
my $flow = $edge->flow();
Returns the flow for this edge, honoring inheritance. An edge without
a specific flow set will inherit the flow from the node it comes from.
=head2 edge_flow()
my $flow = $edge->edge_flow();
Returns the flow for this edge, or undef if it has none set on either
the object itself or its class.
=head2 port()
my ($side, $number) = $edge->port('start');
my ($side, $number) = $edge->port('end');
Return the side and port number where this edge starts or ends.
Returns undef for $side if the edge has no port restriction. The
returned side will be one absolute direction of C<east>, C<west>,
C<north> or C<south>, depending on the port restriction and
flow at that edge.
=head2 get_attributes()
my $att = $object->get_attributes();
Return all effective attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance and default values.
See also L<raw_attributes()>.
=head2 raw_attributes()
my $att = $object->get_attributes();
Return all set attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance, but does not include
default values for unset attributes.
See also L<get_attributes()>.
=head2 attribute related methods
You can call all the various attribute related methods like C<set_attribute()>,
C<get_attribute()>, etc. on an edge, too. For example:
$edge->set_attribute('label', 'by train');
my $attr = $edge->get_attributes();
my $raw_attr = $edge->raw_attributes();
You can find more documentation in L<Graph::Easy>.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

1464
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Edge/Cell.pm Normal file
View File

File diff suppressed because it is too large Load Diff

828
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Group.pm Normal file
View File

@@ -0,0 +1,828 @@
#############################################################################
# A group of nodes. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Group;
use Graph::Easy::Group::Cell;
use Graph::Easy;
use Scalar::Util qw/weaken/;
@ISA = qw/Graph::Easy::Node Graph::Easy/;
$VERSION = '0.76';
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{name} = 'Group #'. $self->{id};
$self->{class} = 'group';
$self->{_cells} = {}; # the Group::Cell objects
# $self->{cx} = 1;
# $self->{cy} = 1;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(graph|name)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Group->new()");
}
$self->{$k} = $args->{$k};
}
$self->{nodes} = {};
$self->{groups} = {};
$self->{att} = {};
$self;
}
#############################################################################
# accessor methods
sub nodes
{
my $self = shift;
wantarray ? ( ord_values ( $self->{nodes} ) ) : scalar keys %{$self->{nodes}};
}
sub edges
{
# edges leading from/to this group
my $self = shift;
wantarray ? ( ord_values ( $self->{edges} ) ) : scalar keys %{$self->{edges}};
}
sub edges_within
{
# edges between nodes inside this group
my $self = shift;
wantarray ? ( ord_values ( $self->{edges_within} ) ) :
scalar keys %{$self->{edges_within}};
}
sub _groups_within
{
my ($self, $level, $max_level, $cur) = @_;
no warnings 'recursion';
push @$cur, ord_values ( $self->{groups} );
return if $level >= $max_level;
for my $g (ord_values ( $self->{groups} ))
{
$g->_groups_within($level+1,$max_level, $cur) if scalar keys %{$g->{groups}} > 0;
}
}
#############################################################################
sub set_attribute
{
my ($self, $name, $val, $class) = @_;
$self->SUPER::set_attribute($name, $val, $class);
# if defined attribute "nodeclass", put our nodes into that class
if ($name eq 'nodeclass')
{
my $class = $self->{att}->{nodeclass};
for my $node (ord_values ( $self->{nodes} ) )
{
$node->sub_class($class);
}
}
$self;
}
sub shape
{
my ($self) = @_;
# $self->{att}->{shape} || $self->attribute('shape');
'';
}
#############################################################################
# node handling
sub add_node
{
# add a node to this group
my ($self,$n) = @_;
if (!ref($n) || !$n->isa("Graph::Easy::Node"))
{
if (!ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
$n = $self->{graph}->add_node($n);
}
$self->{nodes}->{ $n->{name} } = $n;
# if defined attribute "nodeclass", put our nodes into that class
$n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
# register ourselves with the member
$n->{group} = $self;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
$n;
}
sub add_member
{
# add a node or group to this group
my ($self,$n) = @_;
if (!ref($n) || !$n->isa("Graph::Easy::Node"))
{
if (!ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
$n = $self->{graph}->add_node($n);
}
return $self->_add_edge($n) if $n->isa("Graph::Easy::Edge");
return $self->add_group($n) if $n->isa('Graph::Easy::Group');
$self->{nodes}->{ $n->{name} } = $n;
# if defined attribute "nodeclass", put our nodes into that class
my $cl = $self->attribute('nodeclass');
$n->sub_class($cl) if $cl ne '';
# register ourselves with the member
$n->{group} = $self;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
$n;
}
sub del_member
{
# delete a node or group from this group
my ($self,$n) = @_;
# XXX TOOD: groups vs. nodes
my $class = 'nodes'; my $key = 'name';
if ($n->isa('Graph::Easy::Group'))
{
# XXX TOOD: groups vs. nodes
$class = 'groups'; $key = 'id';
}
delete $self->{$class}->{ $n->{$key} };
delete $n->{group}; # unregister us
if ($n->isa('Graph::Easy::Node'))
{
# find all edges that mention this node and drop them from the group
my $edges = $self->{edges_within};
for my $e (ord_values ( $edges))
{
delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
}
}
$self;
}
sub del_node
{
# delete a node from this group
my ($self,$n) = @_;
delete $self->{nodes}->{ $n->{name} };
delete $n->{group}; # unregister us
delete $n->{att}->{group}; # delete the group attribute
# find all edges that mention this node and drop them from the group
my $edges = $self->{edges_within};
for my $e (ord_values ( $edges))
{
delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
}
$self;
}
sub add_nodes
{
my $self = shift;
# make a copy in case of scalars
my @arg = @_;
foreach my $n (@arg)
{
if (!ref($n) && !ref($self->{graph}))
{
return $self->error("Cannot add non node-object $n to group '$self->{name}'");
}
return $self->error("Cannot add group-object $n to group '$self->{name}'")
if $n->isa('Graph::Easy::Group');
$n = $self->{graph}->add_node($n) unless ref($n);
$self->{nodes}->{ $n->{name} } = $n;
# set the proper attribute (for layout)
$n->{att}->{group} = $self->{name};
# XXX TODO TEST!
# # if defined attribute "nodeclass", put our nodes into that class
# $n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
# register ourselves with the member
$n->{group} = $self;
# Register the nodes and the edge with our graph object
# and weaken the references. Be careful to not needlessly
# override and weaken again an already existing reference, this
# is an O(N) operation in most Perl versions, and thus very slow.
# If the node does not belong to a graph yet or belongs to another
# graph, add it to our own graph:
weaken($n->{graph} = $self->{graph}) unless
$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
}
@arg;
}
#############################################################################
sub _del_edge
{
# delete an edge from this group
my ($self,$e) = @_;
delete $self->{edges_within}->{ $e->{id} };
delete $e->{group}; # unregister us
$self;
}
sub _add_edge
{
# add an edge to this group (e.g. when both from/to of this edge belong
# to this group)
my ($self,$e) = @_;
if (!ref($e) || !$e->isa("Graph::Easy::Edge"))
{
return $self->error("Cannot add non edge-object $e to group '$self->{name}'");
}
$self->{edges_within}->{ $e->{id} } = $e;
# if defined attribute "edgeclass", put our edges into that class
my $edge_class = $self->attribute('edgeclass');
$e->sub_class($edge_class) if $edge_class ne '';
# XXX TODO: inline
$self->add_node($e->{from});
$self->add_node($e->{to});
# register us, but don't do weaken() if the ref was already set
weaken($e->{group} = $self) unless defined $e->{group} && $e->{group} == $self;
$e;
}
sub add_edge
{
# Add an edge to the graph of this group, then register it with this group.
my ($self,$from,$to) = @_;
my $g = $self->{graph};
return $self->error("Cannot add edge to group '$self->{name}' without graph")
unless defined $g;
my $edge = $g->add_edge($from,$to);
$self->_add_edge($edge);
}
sub add_edge_once
{
# Add an edge to the graph of this group, then register it with this group.
my ($self,$from,$to) = @_;
my $g = $self->{graph};
return $self->error("Cannot non edge to group '$self->{name}' without graph")
unless defined $g;
my $edge = $g->add_edge_once($from,$to);
# edge already exists => so fetch it
$edge = $g->edge($from,$to) unless defined $edge;
$self->_add_edge($edge);
}
#############################################################################
sub add_group
{
# add a group to us
my ($self,$group) = @_;
# group with that name already exists?
my $name = $group;
$group = $self->{groups}->{ $group } unless ref $group;
# group with that name doesn't exist, so create new one
$group = $self->{graph}->add_group($name) unless ref $group;
# index under the group name for easier lookup
$self->{groups}->{ $group->{name} } = $group;
# make attribute->('group') work
$group->{att}->{group} = $self->{name};
# register group with the graph and ourself
$group->{graph} = $self->{graph};
$group->{group} = $self;
{
no warnings; # don't warn on already weak references
weaken($group->{graph});
weaken($group->{group});
}
$self->{graph}->{score} = undef; # invalidate last layout
$group;
}
# cell management - used by the layouter
sub _cells
{
# return all the cells this group currently occupies
my $self = shift;
$self->{_cells};
}
sub _clear_cells
{
# remove all belonging cells
my $self = shift;
$self->{_cells} = {};
$self;
}
sub _add_cell
{
# add a cell to the list of cells this group covers
my ($self,$cell) = @_;
$cell->_update_boundaries();
$self->{_cells}->{"$cell->{x},$cell->{y}"} = $cell;
$cell;
}
sub _del_cell
{
# delete a cell from the list of cells this group covers
my ($self,$cell) = @_;
delete $self->{_cells}->{"$cell->{x},$cell->{y}"};
delete $cell->{group};
$self;
}
sub _find_label_cell
{
# go through all cells of this group and find one where to attach the label
my $self = shift;
my $g = $self->{graph};
my $align = $self->attribute('align');
my $loc = $self->attribute('labelpos');
# depending on whether the label should be on top or bottom:
my $match = qr/^\s*gt\s*\z/;
$match = qr/^\s*gb\s*\z/ if $loc eq 'bottom';
my $lc; # the label cell
for my $c (ord_values ( $self->{_cells} ))
{
# find a cell where to put the label
next unless $c->{cell_class} =~ $match;
if (defined $lc)
{
if ($align eq 'left')
{
# find top-most, left-most cell
next if $lc->{x} < $c->{x} || $lc->{y} < $c->{y};
}
elsif ($align eq 'center')
{
# just find any top-most cell
next if $lc->{y} < $c->{y};
}
elsif ($align eq 'right')
{
# find top-most, right-most cell
next if $lc->{x} > $c->{x} || $lc->{y} < $c->{y};
}
}
$lc = $c;
}
# find the cell mostly near the center in the found top-row
if (ref($lc) && $align eq 'center')
{
my ($left, $right);
# find left/right most coordinates
for my $c (ord_values ( $self->{_cells} ))
{
next if $c->{y} != $lc->{y};
$left = $c->{x} if !defined $left || $left > $c->{x};
$right = $c->{x} if !defined $right || $right < $c->{x};
}
my $center = int(($right - $left) / 2 + $left);
my $min_dist;
# find the cell mostly near the center in the found top-row
for my $c (ord_values ( $self->{_cells} ))
{
next if $c->{y} != $lc->{y};
# squared to get rid of sign
my $dist = ($center - $c->{x}); $dist *= $dist;
next if defined $min_dist && $dist > $min_dist;
$min_dist = $dist; $lc = $c;
}
}
print STDERR "# Setting label for group '$self->{name}' at $lc->{x},$lc->{y}\n"
if $self->{debug};
$lc->_set_label() if ref($lc);
}
sub layout
{
my $self = shift;
$self->_croak('Cannot call layout() on a Graph::Easy::Group directly.');
}
sub _layout
{
my $self = shift;
###########################################################################
# set local {debug} for groups
local $self->{debug} = $self->{graph}->{debug};
$self->SUPER::_layout();
}
sub _set_cell_types
{
my ($self, $cells) = @_;
# Set the right cell class for all of our cells:
for my $cell (ord_values ( $self->{_cells} ))
{
$cell->_set_type($cells);
}
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Group - A group of nodes (aka subgraph) in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy;
my $bonn = Graph::Easy::Node->new('Bonn');
$bonn->set_attribute('border', 'solid 1px black');
my $berlin = Graph::Easy::Node->new( name => 'Berlin' );
my $cities = Graph::Easy::Group->new(
name => 'Cities',
);
$cities->set_attribute('border', 'dashed 1px blue');
$cities->add_nodes ($bonn);
# $bonn will be ONCE in the group
$cities->add_nodes ($bonn, $berlin);
=head1 DESCRIPTION
A C<Graph::Easy::Group> represents a group of nodes in an C<Graph::Easy>
object. These nodes are grouped together on output.
=head1 METHODS
=head2 new()
my $group = Graph::Easy::Group->new( $options );
Create a new, empty group. C<$options> are the possible options, see
L<Graph::Easy::Node> for a list.
=head2 error()
$last_error = $group->error();
$group->error($error); # set new messages
$group->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $group->as_ascii();
Return the group as a little box drawn in ASCII art as a string.
=head2 name()
my $name = $group->name();
Return the name of the group.
=head2 id()
my $id = $group->id();
Returns the group's unique ID number.
=head2 set_attribute()
$group->set_attribute('border-style', 'none');
Sets the specified attribute of this (and only this!) group to the
specified value.
=head2 add_member()
$group->add_member($node);
$group->add_member($group);
Add the specified object to this group and returns this member. If the
passed argument is a scalar, will treat it as a node name.
Note that each object can only be a member of one group at a time.
=head2 add_node()
$group->add_node($node);
Add the specified node to this group and returns this node.
Note that each object can only be a member of one group at a time.
=head2 add_edge(), add_edge_once()
$group->add_edge($edge); # Graph::Easy::Edge
$group->add_edge($from, $to); # Graph::Easy::Node or
# Graph::Easy::Group
$group->add_edge('From', 'To'); # Scalars
If passed an Graph::Easy::Edge object, moves the nodes involved in
this edge to the group.
if passed two nodes, adds these nodes to the graph (unless they already
exist) and adds an edge between these two nodes. See L<add_edge_once()>
to avoid creating multiple edges.
This method works only on groups that are part of a graph.
Note that each object can only be a member of one group at a time,
and edges are automatically a member of a group if and only if both
the target and the destination node are a member of the same group.
=head2 add_group()
my $inner = $group->add_group('Group name');
my $nested = $group->add_group($group);
Add a group as subgroup to this group and returns this group.
=head2 del_member()
$group->del_member($node);
$group->del_member($group);
Delete the specified object from this group.
=head2 del_node()
$group->del_node($node);
Delete the specified node from this group.
=head2 del_edge()
$group->del_edge($edge);
Delete the specified edge from this group.
=head2 add_nodes()
$group->add_nodes($node, $node2, ... );
Add all the specified nodes to this group and returns them as a list.
=head2 nodes()
my @nodes = $group->nodes();
Returns a list of all node objects that belong to this group.
=head2 edges()
my @edges = $group->edges();
Returns a list of all edge objects that lead to or from this group.
Note: This does B<not> return edges between nodes that are inside the group,
for this see L<edges_within()>.
=head2 edges_within()
my @edges_within = $group->edges_within();
Returns a list of all edge objects that are I<inside> this group, in arbitrary
order. Edges are automatically considered I<inside> a group if their starting
and ending node both are in the same group.
Note: This does B<not> return edges between this group and other groups,
nor edges between this group and nodes outside this group, for this see
L<edges()>.
=head2 groups()
my @groups = $group->groups();
Returns the contained groups of this group as L<Graph::Easy::Group> objects,
in arbitrary order.
=head2 groups_within()
# equivalent to $group->groups():
my @groups = $group->groups_within(); # all
my @toplevel_groups = $group->groups_within(0); # level 0 only
Return the groups that are inside this group, up to the specified level,
in arbitrary order.
The default level is -1, indicating no bounds and thus all contained
groups are returned.
A level of 0 means only the direct children, and hence only the toplevel
groups will be returned. A level 1 means the toplevel groups and their
toplevel children, and so on.
=head2 as_txt()
my $txt = $group->as_txt();
Returns the group as Graph::Easy textual description.
=head2 _find_label_cell()
$group->_find_label_cell();
Called by the layouter once for each group. Goes through all cells of this
group and finds one where to attach the label to. Internal usage only.
=head2 get_attributes()
my $att = $object->get_attributes();
Return all effective attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance and default values.
See also L<raw_attributes()>.
=head2 raw_attributes()
my $att = $object->get_attributes();
Return all set attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance, but does not include
default values for unset attributes.
See also L<get_attributes()>.
=head2 attribute related methods
You can call all the various attribute related methods like C<set_attribute()>,
C<get_attribute()>, etc. on a group, too. For example:
$group->set_attribute('label', 'by train');
my $attr = $group->get_attributes();
You can find more documentation in L<Graph::Easy>.
=head2 layout()
This routine should not be called on groups, it only works on the graph
itself.
=head2 shape()
my $shape = $group->shape();
Returns the shape of the group as string.
=head2 has_as_successor()
if ($group->has_as_successor($other))
{
...
}
Returns true if C<$other> (a node or group) is a successor of this group, e.g.
if there is an edge leading from this group to C<$other>.
=head2 has_as_predecessor()
if ($group->has_as_predecessor($other))
{
...
}
Returns true if the group has C<$other> (a group or node) as predecessor, that
is if there is an edge leading from C<$other> to this group.
=head2 root_node()
my $root = $group->root_node();
Return the root node as L<Graph::Easy::Node> object, if it was
set with the 'root' attribute.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>, L<Graph::Easy::Node>, L<Graph::Easy::Manual>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
See the LICENSE file for more details.
=cut

124
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Group/Anon.pm Normal file
View File

@@ -0,0 +1,124 @@
#############################################################################
# (c) by Tels 2004. Part of Graph::Easy. An anonymous group.
#
#############################################################################
package Graph::Easy::Group::Anon;
use Graph::Easy::Group;
use warnings;
@ISA = qw/Graph::Easy::Group/;
$VERSION = '0.76';
use strict;
sub _init
{
my $self = shift;
$self->SUPER::_init(@_);
$self->{name} = 'Group #' . $self->{id};
$self->{class} = 'group.anon';
$self->{att}->{label} = '';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
sub attributes_as_txt
{
my $self = shift;
$self->SUPER::attributes_as_txt( {
node => {
label => undef,
shape => undef,
class => undef,
} } );
}
sub as_pure_txt
{
'( )';
}
sub _as_part_txt
{
'( )';
}
sub as_graphviz_txt
{
my $self = shift;
my $name = $self->{name};
# quote special chars in name
$name =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
'"' . $name . '"';
}
sub text_styles_as_css
{
'';
}
sub is_anon
{
# is an anon group
1;
}
1;
__END__
=head1 NAME
Graph::Easy::Group::Anon - An anonymous group of nodes in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy::Group::Anon;
my $anon = Graph::Easy::Group::Anon->new();
=head1 DESCRIPTION
A C<Graph::Easy::Group::Anon> represents an anonymous group of nodes,
e.g. a group without a name.
The syntax in the Graph::Easy textual description language looks like this:
( [ Bonn ] -> [ Berlin ] )
This module is loaded and used automatically by Graph::Easy, so there is
no need to use it manually.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy::Group>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

401
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Group/Cell.pm Normal file
View File

@@ -0,0 +1,401 @@
#############################################################################
# A cell of a group during layout. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Group::Cell;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
BEGIN
{
*get_attribute = \&attribute;
}
#############################################################################
# The different types for a group-cell:
use constant {
GROUP_INNER => 0, # completely sourounded by group cells
GROUP_RIGHT => 1, # right border only
GROUP_LEFT => 2, # left border only
GROUP_TOP => 3, # top border only
GROUP_BOTTOM => 4, # bottom border only
GROUP_ALL => 5, # completely sourounded by non-group cells
GROUP_BOTTOM_RIGHT => 6, # bottom and right border
GROUP_BOTTOM_LEFT => 7, # bottom and left border
GROUP_TOP_RIGHT => 8, # top and right border
GROUP_TOP_LEFT => 9, # top and left order
GROUP_MAX => 5, # max number
};
my $border_styles =
{
# type top, bottom, left, right, class
GROUP_INNER() => [ 0, 0, 0, 0, ['gi'] ],
GROUP_RIGHT() => [ 0, 0, 0, 1, ['gr'] ],
GROUP_LEFT() => [ 0, 0, 1, 0, ['gl'] ],
GROUP_TOP() => [ 1, 0, 0, 0, ['gt'] ],
GROUP_BOTTOM() => [ 0, 1, 0, 0, ['gb'] ],
GROUP_ALL() => [ 0, 0, 0, 0, ['ga'] ],
GROUP_BOTTOM_RIGHT() => [ 0, 1, 0, 1, ['gb','gr'] ],
GROUP_BOTTOM_LEFT() => [ 0, 1, 1, 0, ['gb','gl'] ],
GROUP_TOP_RIGHT() => [ 1, 0, 0, 1, ['gt','gr'] ],
GROUP_TOP_LEFT() => [ 1, 0, 1, 0, ['gt','gl'] ],
};
my $border_name = [ 'top', 'bottom', 'left', 'right' ];
sub _css
{
my ($c, $id, $group, $border) = @_;
my $css = '';
for my $type (0 .. 5)
{
my $b = $border_styles->{$type};
# If border eq 'none', this would needlessly repeat the "border: none"
# from the general group class.
next if $border eq 'none';
my $cl = '.' . $b->[4]->[0]; # $cl .= "-$group" unless $group eq '';
$css .= "table.graph$id $cl {";
if ($type == GROUP_INNER)
{
$css .= " border: none;"; # shorter CSS
}
elsif ($type == GROUP_ALL)
{
$css .= " border-style: $border;"; # shorter CSS
}
else
{
for (my $i = 0; $i < 4; $i++)
{
$css .= ' border-' . $border_name->[$i] . "-style: $border;" if $b->[$i];
}
}
$css .= "}\n";
}
$css;
}
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = 'group';
$self->{cell_class} = ' gi';
$self->{name} = '';
$self->{'x'} = 0;
$self->{'y'} = 0;
# XXX TODO check arguments
foreach my $k (sort keys %$args)
{
$self->{$k} = $args->{$k};
}
if (defined $self->{group})
{
# register ourselves at this group
$self->{group}->_add_cell ($self);
# XXX CHECK also implement sub_class()
$self->{class} = $self->{group}->{class};
$self->{class} = 'group' unless defined $self->{class};
}
$self;
}
sub _set_type
{
# set the proper type of this cell based on the sourrounding cells
my ($self, $cells) = @_;
# +------+--------+-------+
# | LT TOP RU |
# + + + +
# | LEFT INNER Right |
# + + + +
# | LB BOTTOM RB |
# +------+--------+-------+
my @coord = (
[ 0, -1, ' gt' ],
[ +1, 0, ' gr' ],
[ 0, +1, ' gb' ],
[ -1, 0, ' gl' ],
);
my ($sx,$sy) = ($self->{x},$self->{y});
my $class = '';
my $gr = $self->{group};
foreach my $co (@coord)
{
my ($x,$y,$c) = @$co; $x += $sx; $y += $sy;
my $cell = $cells->{"$x,$y"};
# belongs to the same group?
my $go = 0; $go = $cell->group() if UNIVERSAL::can($cell, 'group');
$class .= $c unless defined $go && $gr == $go;
}
$class = ' ga' if $class eq ' gt gr gb gl';
$self->{cell_class} = $class;
$self;
}
sub _set_label
{
my $self = shift;
$self->{has_label} = 1;
$self->{name} = $self->{group}->label();
}
sub shape
{
'rect';
}
sub attribute
{
my ($self, $name) = @_;
# print STDERR "called attribute($name)\n";
# return $self->{group}->attribute($name);
my $group = $self->{group};
return $group->{att}->{$name} if exists $group->{att}->{$name};
$group->{cache} = {} unless exists $group->{cache};
$group->{cache}->{att} = {} unless exists $group->{cache}->{att};
my $cache = $group->{cache}->{att};
return $cache->{$name} if exists $cache->{$name};
$cache->{$name} = $group->attribute($name);
}
use constant isa_cell => 1;
#############################################################################
# conversion to ASCII or HTML
sub as_ascii
{
my ($self, $x,$y) = @_;
my $fb = $self->_framebuffer($self->{w}, $self->{h});
my $border_style = $self->attribute('borderstyle');
my $EM = 14;
# use $self here and not $self->{group} to engage attribute cache:
my $border_width = Graph::Easy::_border_width_in_pixels($self,$EM);
# convert overly broad borders to the correct style
$border_style = 'bold' if $border_width > 2;
$border_style = 'broad' if $border_width > $EM * 0.2 && $border_width < $EM * 0.75;
$border_style = 'wide' if $border_width >= $EM * 0.75;
if ($border_style ne 'none')
{
#########################################################################
# draw our border into the framebuffer
my $c = $self->{cell_class};
my $b_top = $border_style;
my $b_left = $border_style;
my $b_right = $border_style;
my $b_bottom = $border_style;
if ($c !~ 'ga')
{
$b_top = 'none' unless $c =~ /gt/;
$b_left = 'none' unless $c =~ /gl/;
$b_right = 'none' unless $c =~ /gr/;
$b_bottom = 'none' unless $c =~ /gb/;
}
$self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top, $x, $y);
}
if ($self->{has_label})
{
# include our label
my $align = $self->attribute('align');
# the default label cell as a top border, but no left/right border
my $ys = 0.5;
$ys = 0 if $border_style eq 'none';
my $h = $self->{h} - 1; $h ++ if $border_style eq 'none';
$self->_printfb_aligned ($fb, 0, $ys, $self->{w}, $h,
$self->_aligned_label($align), 'middle');
}
join ("\n", @$fb);
}
sub class
{
my $self = shift;
$self->{class} . $self->{cell_class};
}
#############################################################################
# for rendering this cell as ASCII/Boxart, we need to correct our width based
# on whether we have a border or not. But this is only known after parsing is
# complete.
sub _correct_size
{
my ($self,$format) = @_;
if (!defined $self->{w})
{
my $border = $self->attribute('borderstyle');
$self->{w} = 0;
$self->{h} = 0;
# label needs space
$self->{h} = 1 if $self->{has_label};
if ($border ne 'none')
{
# class "gt", "gb", "gr" or "gr" will be compressed away
# (e.g. only edge cells will be existent)
if ($self->{has_label} || ($self->{cell_class} =~ /g[rltb] /))
{
$self->{w} = 2;
$self->{h} = 2;
}
elsif ($self->{cell_class} =~ /^ g[rl]\z/)
{
$self->{w} = 2;
}
elsif ($self->{cell_class} =~ /^ g[bt]\z/)
{
$self->{h} = 2;
}
}
}
if ($self->{has_label})
{
my ($w,$h) = $self->dimensions();
$self->{h} += $h;
$self->{w} += $w;
}
}
1;
__END__
=head1 NAME
Graph::Easy::Group::Cell - A cell in a group
=head1 SYNOPSIS
use Graph::Easy;
my $ssl = Graph::Easy::Edge->new( );
$ssl->set_attributes(
label => 'encrypted connection',
style => '-->',
color => 'red',
);
$graph = Graph::Easy->new();
$graph->add_edge('source', 'destination', $ssl);
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Group::Cell> represents a cell of a group.
Group cells can have a background and, if they are on the outside, a border.
There should be no need to use this package directly.
=head1 METHODS
=head2 error()
$last_error = $group->error();
$group->error($error); # set new messages
$group->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 as_ascii()
my $ascii = $cell->as_ascii();
Returns the cell as a little ascii representation.
=head2 as_html()
my $html = $cell->as_html($tag,$id);
Returns the cell as HTML code.
=head2 label()
my $label = $cell->label();
Returns the name (also known as 'label') of the cell.
=head2 class()
my $class = $cell->class();
Returns the classname(s) of this cell, like:
group_cities gr gb
for a cell with a bottom (gb) and right (gr) border in the class C<cities>.
=head1 EXPORT
None.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

1071
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout.pm Normal file
View File

File diff suppressed because it is too large Load Diff

570
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Chain.pm Normal file
View File

@@ -0,0 +1,570 @@
#############################################################################
# One chain of nodes in a Graph::Easy - used internally for layouts.
#
# (c) by Tels 2004-2006. Part of Graph::Easy
#############################################################################
package Graph::Easy::Layout::Chain;
use Graph::Easy::Base;
$VERSION = '0.76';
@ISA = qw/Graph::Easy::Base/;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
use constant {
_ACTION_NODE => 0, # place node somewhere
_ACTION_TRACE => 1, # trace path from src to dest
_ACTION_CHAIN => 2, # place node in chain (with parent)
_ACTION_EDGES => 3, # trace all edges (shortes connect. first)
};
#############################################################################
sub _init
{
# Generic init routine, to be overriden in subclasses.
my ($self,$args) = @_;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(start|graph)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to __PACKAGE__->new()");
}
$self->{$k} = $args->{$k};
}
$self->{end} = $self->{start};
# store chain at node (to lookup node => chain info)
$self->{start}->{_chain} = $self;
$self->{start}->{_next} = undef;
$self->{len} = 1;
$self;
}
sub start
{
# return first node in the chain
my $self = shift;
$self->{start};
}
sub end
{
# return last node in the chain
my $self = shift;
$self->{end};
}
sub add_node
{
# add a node at the end of the chain
my ($self, $node) = @_;
# store at end
$self->{end}->{_next} = $node;
$self->{end} = $node;
# store chain at node (to lookup node => chain info)
$node->{_chain} = $self;
$node->{_next} = undef;
$self->{len} ++;
$self;
}
sub length
{
# Return the length of the chain in nodes. Takes optional
# node from where to calculate length.
my ($self, $node) = @_;
return $self->{len} unless defined $node;
my $len = 0;
while (defined $node)
{
$len++; $node = $node->{_next};
}
$len;
}
sub nodes
{
# return all the nodes in the chain as a list, in order.
my $self = shift;
my @nodes = ();
my $n = $self->{start};
while (defined $n)
{
push @nodes, $n;
$n = $n->{_next};
}
@nodes;
}
sub layout
{
# Return an action stack containing the nec. actions to
# lay out the nodes in the chain, plus any connections between
# them.
my ($self, $edge) = @_;
# prevent doing it twice
return [] if $self->{_done}; $self->{_done} = 1;
my @TODO = ();
my $g = $self->{graph};
# first, layout all the nodes in the chain:
# start with first node
my $pre = $self->{start}; my $n = $pre->{_next};
if (exists $pre->{_todo})
{
# edges with a flow attribute must be handled differently
# XXX TODO: the test for attribute('flow') might be wrong (raw_attribute()?)
if ($edge && ($edge->{to} == $pre) && ($edge->attribute('flow') || $edge->has_ports()))
{
push @TODO, $g->_action( _ACTION_CHAIN, $pre, 0, $edge->{from}, $edge);
}
else
{
push @TODO, $g->_action( _ACTION_NODE, $pre, 0, $edge );
}
}
print STDERR "# Stack after first:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
while (defined $n)
{
if (exists $n->{_todo})
{
# CHAIN means if $n isn't placed yet, it will be done with
# $pre as parent:
# in case there are multiple edges to the target node, use the first
# one to determine the flow:
my @edges = $g->edge($pre,$n);
push @TODO, $g->_action( _ACTION_CHAIN, $n, 0, $pre, $edges[0] );
}
$pre = $n;
$n = $n->{_next};
}
print STDERR "# Stack after chaining:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# link from each node to the next
$pre = $self->{start}; $n = $pre->{_next};
while (defined $n)
{
# first do edges going from P to N
#for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$pre->{edges}})
for my $e (ord_values ( $pre->{edges}))
{
# skip selfloops and backward links, these will be done later
next if $e->{to} != $n;
next unless exists $e->{_todo};
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
# # skip edges with a flow
# next if exists $e->{att}->{start} || exist $e->{att}->{end};
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
} continue { $pre = $n; $n = $n->{_next}; }
print STDERR "# Stack after chain-linking:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# Do all other links inside the chain (backwards, going forward more than
# one node etc)
$n = $self->{start};
while (defined $n)
{
my @edges;
my @count;
print STDERR "# inter-chain link from $n->{name}\n" if $g->{debug};
# gather all edges starting at $n, but do the ones with a flow first
# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
for my $e (ord_values ( $n->{edges}))
{
# skip selfloops, these will be done later
next if $e->{to} == $n;
next if !ref($e->{to}->{_chain});
next if !ref($e->{from}->{_chain});
next if $e->has_ports();
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
print STDERR "# inter-chain link from $n->{name} to $e->{to}->{name}\n" if $g->{debug};
# leaving the chain?
next if $e->{to}->{_chain} != $self;
# print STDERR "# trying for $n->{name}:\t $e->{from}->{name} to $e->{to}->{name}\n";
next unless exists $e->{_todo};
# calculate for this edge, how far it goes
my $count = 0;
my $curr = $n;
while (defined $curr && $curr != $e->{to})
{
$curr = $curr->{_next}; $count ++;
}
if (!defined $curr)
{
# edge goes backward
# start at $to
$curr = $e->{to};
$count = 0;
while (defined $curr && $curr != $e->{from})
{
$curr = $curr->{_next}; $count ++;
}
$count = 100000 if !defined $curr; # should not happen
}
push @edges, [ $count, $e ];
push @count, [ $count, $e->{from}->{name}, $e->{to}->{name} ];
}
# use Data::Dumper; print STDERR "count\n", Dumper(@count);
# do edges, shortest first
for my $e (sort { $a->[0] <=> $b->[0] } @edges)
{
push @TODO, [ _ACTION_TRACE, $e->[1] ];
delete $e->[1]->{_todo};
}
$n = $n->{_next};
}
# also do all selfloops on $n
$n = $self->{start};
while (defined $n)
{
# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
for my $e (ord_values $n->{edges})
{
next unless exists $e->{_todo};
# print STDERR "# $e->{from}->{name} to $e->{to}->{name} on $n->{name}\n";
# print STDERR "# ne $e->{to} $n $e->{id}\n"
# if $e->{from} != $n || $e->{to} != $n; # no selfloop?
next if $e->{from} != $n || $e->{to} != $n; # no selfloop?
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
$n = $n->{_next};
}
print STDERR "# Stack after self-loops:\n" if $g->{debug};
$g->_dump_stack(@TODO) if $g->{debug};
# XXX TODO
# now we should do any links that start or end at this chain, recursively
$n = $self->{start};
while (defined $n)
{
# all chains that start at this node
for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
{
my $to = $e->{to};
# skip links to groups
next if $to->isa('Graph::Easy::Group');
# print STDERR "# chain-tracking to: $to->{name} $to->{_chain}\n";
next unless exists $to->{_chain} && ref($to->{_chain}) =~ /Chain/;
my $chain = $to->{_chain};
next if $chain->{_done};
# print STDERR "# chain-tracking to: $to->{name}\n";
# pass the edge along, in case it has a flow
# my @pass = ();
# push @pass, $e if $chain->{_first} && $e->{to} == $chain->{_first};
push @TODO, @{ $chain->layout($e) } unless $chain->{_done};
# link the edges to $to
next unless exists $e->{_todo}; # was already done above?
# next if $e->has_ports();
push @TODO, [ _ACTION_TRACE, $e ];
delete $e->{_todo};
}
$n = $n->{_next};
}
\@TODO;
}
sub dump
{
# dump the chain to STDERR
my ($self, $indent) = @_;
$indent = '' unless defined $indent;
print STDERR "#$indent chain id $self->{id} (len $self->{len}):\n";
print STDERR "#$indent is empty\n" and return if $self->{len} == 0;
my $n = $self->{start};
while (defined $n)
{
print STDERR "#$indent $n->{name} (chain id: $n->{_chain}->{id})\n";
$n = $n->{_next};
}
$self;
}
sub merge
{
# take another chain, and merge it into ourselves. If $where is defined,
# absorb only the nodes from $where onwards (instead of all of them).
my ($self, $other, $where) = @_;
my $g = $self->{graph};
print STDERR "# panik: ", join(" \n",caller()),"\n" if !defined $other;
print STDERR
"# Merging chain $other->{id} (len $other->{len}) into $self->{id} (len $self->{len})\n"
if $g->{debug};
print STDERR
"# Merging from $where->{name} onwards\n"
if $g->{debug} && ref($where);
# cannot merge myself into myself (without allocating infinitely memory)
return if $self == $other;
# start at start as default
$where = undef unless ref($where) && exists $where->{_chain} && $where->{_chain} == $other;
$where = $other->{start} unless defined $where;
# make all nodes from chain #1 belong to it (to detect loops)
my $n = $self->{start};
while (defined $n)
{
$n->{_chain} = $self;
$n = $n->{_next};
}
print STDERR "# changed nodes\n" if $g->{debug};
$self->dump() if $g->{debug};
# terminate at $where
$self->{end}->{_next} = $where;
$self->{end} = $other->{end};
# start at joiner
$n = $where;
while (ref($n))
{
$n->{_chain} = $self;
my $pre = $n;
$n = $n->{_next};
# sleep(1);
# print "# at $n->{name} $n->{_chain}\n" if ref($n);
if (ref($n) && defined $n->{_chain} && $n->{_chain} == $self) # already points into ourself?
{
# sleep(1);
# print "# pre $pre->{name} $pre->{_chain}\n";
$pre->{_next} = undef; # terminate
$self->{end} = $pre;
last;
}
}
# could speed this up
$self->{len} = 0; $n = $self->{start};
while (defined $n)
{
$self->{len}++; $n = $n->{_next};
}
# print "done merging, dumping result:\n";
# $self->dump(); sleep(10);
if (defined $other->{start} && $where == $other->{start})
{
# we absorbed the other chain completely, so drop it
$other->{end} = undef;
$other->{start} = undef;
$other->{len} = 0;
# caller is responsible for cleaning it up
}
print STDERR "# after merging\n" if $g->{debug};
$self->dump() if $g->{debug};
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Chain - Chain of nodes for layouter
=head1 SYNOPSIS
# used internally, do not use directly
use Graph::Easy;
use Graph::Easy::Layout::Chain;
my $graph = Graph::Easy->new( );
my ($node, $node2) = $graph->add_edge( 'A', 'B' );
my $chain = Graph::Easy::Layout::Chain->new(
start => $node,
graph => $graph, );
$chain->add_node( $node2 );
=head1 DESCRIPTION
A C<Graph::Easy::Layout::Chain> object represents a chain of nodes
for the layouter.
=head1 METHODS
=head2 new()
my $chain = Graph::Easy::Layout::Chain->new( start => $node );
Create a new chain and set its starting node to C<$node>.
=head2 length()
my $len = $chain->length();
Return the length of the chain, in nodes.
my $len = $chain->length( $node );
Given an optional C<$node> as argument, returns the length
from that node onwards. For the chain with the three nodes
A, B and C would return 3, 2, and 1 for A, B and C, respectively.
Returns 0 if the passed node is not part of this chain.
=head2 nodes()
my @nodes = $chain->nodes();
Return all the node objects in the chain as list, in order.
=head2 add_node()
$chain->add_node( $node );
Add C<$node> to the end of the chain.
=head2 start()
my $node = $chain->start();
Return first node in the chain.
=head2 end()
my $node = $chain->end();
Return last node in the chain.
=head2 layout()
my $todo = $chain->layout();
Return an action stack as array ref, containing the nec. actions to
layout the chain (nodes, plus interlinks in the chain).
Will recursively traverse all chains linked to this chain.
=head2 merge()
my $chain->merge ( $other_chain );
my $chain->merge ( $other_chain, $where );
Merge the other chain into ourselves, adding its nodes at our end.
The other chain is emptied and must be deleted by the caller.
If C<$where> is defined and a member of C<$other_chain>, absorb only the
nodes from C<$where> onwards, instead of all of them.
=head2 error()
$last_error = $node->error();
$node->error($error); # set new messages
$node->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 dump()
$chain->dump();
Dump the chain to STDERR, to aid debugging.
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy>, L<Graph::Easy::Layout>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

251
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Force.pm Normal file
View File

@@ -0,0 +1,251 @@
#############################################################################
# Force-based layouter for Graph::Easy.
#
# (c) by Tels 2004-2007.
#############################################################################
package Graph::Easy::Layout::Force;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _layout_force
{
# Calculate for each node the force on it, then move them accordingly.
# When things have settled, stop.
my ($self) = @_;
# For each node, calculate the force acting on it, separated into two
# components along the X and Y axis:
# XXX TODO: replace with all contained nodes + groups
my @nodes = $self->nodes();
return if @nodes == 0;
my $root = $self->root_node();
if (!defined $root)
{
# find a suitable root node
$root = $nodes[0];
}
# this node never moves
$root->{_pinned} = undef;
$root->{x} = 0;
$root->{y} = 0;
# get the "gravity" force
my $gx = 0; my $gy = 0;
my $flow = $self->flow();
if ($flow == 0)
{
$gx = 1;
}
elsif ($flow == 90)
{
$gy = -1;
}
elsif ($flow == 270)
{
$gy = 1;
}
else # ($flow == 180)
{
$gx = -1;
}
my @particles;
# set initial positions
for my $n (@nodes)
{
# the net force on this node is the gravity
$n->{_x_force} = $gx;
$n->{_y_force} = $gy;
if ($root == $n || defined $n->{origin})
{
# nodes that are relative to another are "pinned"
$n->{_pinned} = undef;
}
else
{
$n->{x} = rand(100);
$n->{y} = rand(100);
push @particles, $n;
}
}
my $energy = 1;
while ($energy > 0.1)
{
$energy = 0;
for my $n (@particles)
{
# reset forces on this node
$n->{_x_force} = 0;
$n->{_y_force} = 0;
# Add forces of all other nodes. We need to include pinned nodes here,
# too, since a moving node might get near a pinned one and get repelled.
for my $n2 (@nodes)
{
next if $n2 == $n; # don't repel yourself
my $dx = ($n->{x} - $n2->{x});
my $dy = ($n->{y} - $n2->{y});
my $r = $dx * $dx + $dy * $dy;
$r = 0.01 if $r < 0.01; # too small?
if ($r < 4)
{
# not too big
$n->{_x_force} += 1 / $dx * $dx;
$n->{_y_force} += 1 / $dy * $dy;
my $dx2 = 1 / $dx * $dx;
my $dy2 = 1 / $dy * $dy;
print STDERR "# Force between $n->{name} and $n2->{name}: fx $dx2, fy $dy2\n";
}
}
# for all edges connected at this node
for my $e (ord_values ( $n->{edges} ))
{
# exclude self-loops
next if $e->{from} == $n && $e->{to} == $n;
# get the other end-point of this edge
my $n2 = $e->{from}; $n2 = $e->{to} if $n2 == $n;
# XXX TODO
# we should "connect" the edges to the appropriate port so that
# they excert an off-center force
my $dx = -($n->{x} - $n2->{x}) / 2;
my $dy = -($n->{y} - $n2->{y}) / 2;
print STDERR "# Spring force between $n->{name} and $n2->{name}: fx $dx, fy $dy\n";
$n->{_x_force} += $dx;
$n->{_y_force} += $dy;
}
print STDERR "# $n->{name}: Summed force: fx $n->{_x_force}, fy $n->{_y_force}\n";
# for grid-like layouts, add a small force drawing this node to the gridpoint
# 0.7 => 1 - 0.7 => 0.3
# 1.2 => 1 - 1.2 => -0.2
my $dx = int($n->{x} + 0.5) - $n->{x};
$n->{_x_force} += $dx;
my $dy = int($n->{y} + 0.5) - $n->{y};
$n->{_y_force} += $dy;
print STDERR "# $n->{name}: Final force: fx $n->{_x_force}, fy $n->{_y_force}\n";
$energy += $n->{_x_force} * $n->{_x_force} + $n->{_x_force} * $n->{_y_force};
print STDERR "# Net energy: $energy\n";
}
# after having calculated all forces, move the nodes
for my $n (@particles)
{
my $dx = $n->{_x_force};
$dx = 5 if $dx > 5; # limit it
$n->{x} += $dx;
my $dy = $n->{_y_force};
$dy = 5 if $dy > 5; # limit it
$n->{y} += $dy;
print STDERR "# $n->{name}: Position $n->{x}, $n->{y}\n";
}
sleep(1); print STDERR "\n";
}
for my $n (@nodes)
{
delete $n->{_x_force};
delete $n->{_y_force};
}
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Force - Force-based layouter for Graph::Easy
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
$graph->add_edge ('Bonn', 'Berlin');
$graph->add_edge ('Bonn', 'Ulm');
$graph->add_edge ('Ulm', 'Berlin');
$graph->layout( type => 'force' );
print $graph->as_ascii( );
# prints:
# +------------------------+
# | v
# +------+ +-----+ +--------+
# | Bonn | --> | Ulm | --> | Berlin |
# +------+ +-----+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Force> contains routines that calculate a
force-based layout for a graph.
Nodes repell each other, while edges connecting them draw them together.
The layouter calculates the forces on each node, then moves them around
according to these forces until things have settled down.
Used automatically by Graph::Easy.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS
This module injects the following methods into Graph::Easy:
=head2 _layout_force()
Calculates the node position with a force-based method.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

348
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Grid.pm Normal file
View File

@@ -0,0 +1,348 @@
#############################################################################
# Grid-management and layout preparation.
#
# (c) by Tels 2004-2006.
#############################################################################
package Graph::Easy::Layout::Grid;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _balance_sizes
{
# Given a list of column/row sizes and a minimum size that their sum must
# be, will grow individual sizes until the constraint (sum) is met.
my ($self, $sizes, $need) = @_;
# XXX TODO: we can abort the loop and distribute the remaining nec. size
# once all elements in $sizes are equal.
return if $need < 1;
# if there is only one element, return it immediately
if (@$sizes == 1)
{
$sizes->[0] = $need if $sizes->[0] < $need;
return;
}
# endless loop until constraint is met
while (1)
{
# find the smallest size, and also compute their sum
my $sum = 0; my $i = 0;
my $sm = $need + 1; # start with an arbitrary size
my $sm_i = 0; # if none is != 0, then use the first
for my $s (@$sizes)
{
$sum += $s;
next if $s == 0;
if ($s < $sm)
{
$sm = $s; $sm_i = $i;
}
$i++;
}
# their sum is already equal or bigger than what we need?
last if $sum >= $need;
# increase the smallest size by one, then try again
$sizes->[$sm_i]++;
}
# use Data::Dumper; print STDERR "# " . Dumper($sizes),"\n";
undef;
}
sub _prepare_layout
{
# this method is used by as_ascii() and as_svg() to find out the
# sizes and placement of the different cells (edges, nodes etc).
my ($self,$format) = @_;
# Find out for each row and column how big they are:
# +--------+-----+------+
# | Berlin | --> | Bonn |
# +--------+-----+------+
# results in:
# w, h, x, y
# 0,0 => 10, 3, 0, 0
# 1,0 => 7, 3, 10, 0
# 2,0 => 8, 3, 16, 0
# Technically, we also need to "compress" away non-existent columns/rows.
# We achieve that by simply rendering them with size 0, so they become
# practically invisible.
my $cells = $self->{cells};
my $rows = {};
my $cols = {};
# the last column/row (highest X,Y pair)
my $mx = -1000000; my $my = -1000000;
# We need to do this twice, once for single-cell objects, and again for
# objects covering multiple cells. The single-cell objects can be solved
# first:
# find all x and y occurrences to sort them by row/columns
for my $cell (ord_values $cells)
{
my ($x,$y) = ($cell->{x}, $cell->{y});
{
no strict 'refs';
my $method = '_correct_size_' . $format;
$method = '_correct_size' unless $cell->can($method);
$cell->$method();
}
my $w = $cell->{w} || 0;
my $h = $cell->{h} || 0;
# Set the minimum cell size only for single-celled objects:
if ( (($cell->{cx}||1) + ($cell->{cy}||1)) == 2)
{
# record maximum size for that col/row
$rows->{$y} = $h if $h >= ($rows->{$y} || 0);
$cols->{$x} = $w if $w >= ($cols->{$x} || 0);
}
# Find highest X,Y pair. Always use x,y, and not x+cx,y+cy, because
# a multi-celled object "sticking" out will not count unless there
# is another object in the same row/column.
$mx = $x if $x > $mx;
$my = $y if $y > $my;
}
# insert a dummy row/column with size=0 as last
$rows->{$my+1} = 0;
$cols->{$mx+1} = 0;
# do the last step again, but for multi-celled objects
for my $cell (ord_values $cells)
{
my ($x,$y) = ($cell->{x}, $cell->{y});
my $w = $cell->{w} || 0;
my $h = $cell->{h} || 0;
# Set the minimum cell size only for multi-celled objects:
if ( (($cell->{cx} || 1) + ($cell->{cy}||1)) > 2)
{
$cell->{cx} ||= 1;
$cell->{cy} ||= 1;
# do this twice, for X and Y:
# print STDERR "\n# ", $cell->{name} || $cell->{id}, " cx=$cell->{cx} cy=$cell->{cy} $cell->{w},$cell->{h}:\n";
# create an array with the current sizes for the affacted rows/columns
my @sizes;
# print STDERR "# $cell->{cx} $cell->{cy} at cx:\n";
# XXX TODO: no need to do this for empty/zero cols
for (my $i = 0; $i < $cell->{cx}; $i++)
{
push @sizes, $cols->{$i+$x} || 0;
}
$self->_balance_sizes(\@sizes, $cell->{w});
# store the result back
for (my $i = 0; $i < $cell->{cx}; $i++)
{
# print STDERR "# store back $sizes[$i] to col ", $i+$x,"\n";
$cols->{$i+$x} = $sizes[$i];
}
@sizes = ();
# print STDERR "# $cell->{cx} $cell->{cy} at cy:\n";
# XXX TODO: no need to do this for empty/zero cols
for (my $i = 0; $i < $cell->{cy}; $i++)
{
push @sizes, $rows->{$i+$y} || 0;
}
$self->_balance_sizes(\@sizes, $cell->{h});
# store the result back
for (my $i = 0; $i < $cell->{cy}; $i++)
{
# print STDERR "# store back $sizes[$i] to row ", $i+$y,"\n";
$rows->{$i+$y} = $sizes[$i];
}
}
}
print STDERR "# Calculating absolute positions for rows/columns\n" if $self->{debug};
# Now run through all rows/columns and get their absolute pos by taking all
# previous ones into account.
my $pos = 0;
for my $y (sort { $a <=> $b } keys %$rows)
{
my $s = $rows->{$y};
$rows->{$y} = $pos; # first is 0, second is $rows[1] etc
$pos += $s;
}
$pos = 0;
for my $x (sort { $a <=> $b } keys %$cols)
{
my $s = $cols->{$x};
$cols->{$x} = $pos;
$pos += $s;
}
# find out max. dimensions for framebuffer
print STDERR "# Finding max. dimensions for framebuffer\n" if $self->{debug};
my $max_y = 0; my $max_x = 0;
for my $v (ord_values $cells)
{
# Skip multi-celled nodes for later.
next if ($v->{cx}||1) + ($v->{cy}||1) != 2;
# X and Y are col/row, so translate them to real pos
my $x = $cols->{ $v->{x} };
my $y = $rows->{ $v->{y} };
# Also set correct the width/height of each cell to be the maximum
# width/height of that row/column and store the previous size in 'minw'
# and 'minh', respectively.
$v->{minw} = $v->{w};
$v->{minh} = $v->{h};
# find next col/row
my $nx = $v->{x} + 1;
my $next_col = $cols->{ $nx };
my $ny = $v->{y} + 1;
my $next_row = $rows->{ $ny };
$next_col = $cols->{ ++$nx } while (!defined $next_col);
$next_row = $rows->{ ++$ny } while (!defined $next_row);
$v->{w} = $next_col - $x;
$v->{h} = $next_row - $y;
my $m = $y + $v->{h} - 1;
$max_y = $m if $m > $max_y;
$m = $x + $v->{w} - 1;
$max_x = $m if $m > $max_x;
}
# repeat the previous step, now for multi-celled objects
foreach my $v (ord_values ( $self->{cells} ))
{
next unless defined $v->{x} && (($v->{cx}||1) + ($v->{cy}||1) > 2);
# X and Y are col/row, so translate them to real pos
my $x = $cols->{ $v->{x} };
my $y = $rows->{ $v->{y} };
$v->{minw} = $v->{w};
$v->{minh} = $v->{h};
# find next col/row
my $nx = $v->{x} + ($v->{cx} || 1);
my $next_col = $cols->{ $nx };
my $ny = $v->{y} + ($v->{cy} || 1);
my $next_row = $rows->{ $ny };
$next_col = $cols->{ ++$nx } while (!defined $next_col);
$next_row = $rows->{ ++$ny } while (!defined $next_row);
$v->{w} = $next_col - $x;
$v->{h} = $next_row - $y;
my $m = $y + $v->{h} - 1;
$max_y = $m if $m > $max_y;
$m = $x + $v->{w} - 1;
$max_x = $m if $m > $max_x;
}
# return what we found out:
($rows,$cols,$max_x,$max_y);
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Grid - Grid management and size calculation
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Grid> contains routines that calculate cell sizes
on the grid, which is necessary for ASCII, boxart and SVG output.
Used automatically by Graph::Easy.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS
This module injects the following methods into Graph::Easy:
=head2 _prepare_layout()
my ($rows,$cols,$max_x,$max_y, \@V) = $graph->_prepare_layout();
Returns two hashes (C<$rows> and C<$cols>), containing the columns and rows
of the layout with their nec. sizes (in chars) plus the maximum
framebuffer size nec. for this layout. Also returns reference of
a list of all cells to be rendered.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

916
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Path.pm Normal file
View File

@@ -0,0 +1,916 @@
#############################################################################
# Path and cell management for Graph::Easy.
#
#############################################################################
package Graph::Easy::Layout::Path;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy::Node;
use strict;
use warnings;
use Graph::Easy::Edge::Cell qw/
EDGE_END_E EDGE_END_N EDGE_END_S EDGE_END_W
/;
sub _shuffle_dir
{
# take a list with four entries and shuffle them around according to $dir
my ($self, $e, $dir) = @_;
# $dir: 0 => north, 90 => east, 180 => south, 270 => west
$dir = 90 unless defined $dir; # default is east
return [ @$e ] if $dir == 90; # default is no shuffling
my @shuffle = (0,1,2,3); # the default
@shuffle = (1,2,0,3) if $dir == 180; # south
@shuffle = (2,3,1,0) if $dir == 270; # west
@shuffle = (3,0,2,1) if $dir == 0; # north
[
$e->[ $shuffle[0] ],
$e->[ $shuffle[1] ],
$e->[ $shuffle[2] ],
$e->[ $shuffle[3] ],
];
}
sub _shift
{
# get a flow shifted by X° to $dir
my ($self, $turn) = @_;
my $dir = $self->flow();
$dir += $turn;
$dir += 360 if $dir < 0;
$dir -= 360 if $dir > 360;
$dir;
}
sub _near_places
{
# Take a node and return a list of possible placements around it and
# prune out already occupied cells. $d is the distance from the node
# border and defaults to two (for placements). Set it to one for
# adjacent cells.
# If defined, $type contains four flags for each direction. If undef,
# two entries (x,y) will be returned for each pos, instead of (x,y,type).
# If $loose is true, no checking whether the returned fields are free
# is done.
my ($n, $cells, $d, $type, $loose, $dir) = @_;
my $cx = $n->{cx} || 1;
my $cy = $n->{cy} || 1;
$d = 2 unless defined $d; # default is distance = 2
my $flags = $type;
if (ref($flags) ne 'ARRAY')
{
$flags = [
EDGE_END_W,
EDGE_END_N,
EDGE_END_E,
EDGE_END_S,
];
}
$dir = $n->flow() unless defined $dir;
my $index = $n->_shuffle_dir( [ 0,3,6,9], $dir);
my @places = ();
# single-celled node
if ($cx + $cy == 2)
{
my @tries = (
$n->{x} + $d, $n->{y}, $flags->[0], # right
$n->{x}, $n->{y} + $d, $flags->[1], # down
$n->{x} - $d, $n->{y}, $flags->[2], # left
$n->{x}, $n->{y} - $d, $flags->[3], # up
);
for my $i (0..3)
{
my $idx = $index->[$i];
my ($x,$y,$t) = ($tries[$idx], $tries[$idx+1], $tries[$idx+2]);
# print STDERR "# Considering place $x, $y \n";
# This quick check does not take node clusters or multi-celled nodes
# into account. These are handled in $node->_do_place() later.
next if !$loose && exists $cells->{"$x,$y"};
push @places, $x, $y;
push @places, $t if defined $type;
}
return @places;
}
# Handle a multi-celled node. For a 3x2 node:
# A B C
# J [00][10][20] D
# I [10][11][21] E
# H G F
# we have 10 (3 * 2 + 2 * 2) places to consider
my $nx = $n->{x};
my $ny = $n->{y};
my ($px,$py);
my $idx = 0;
my @results = ( [], [], [], [] );
$cy--; $cx--;
my $t = $flags->[$idx++];
# right
$px = $nx + $cx + $d;
for my $y (0 .. $cy)
{
$py = $y + $ny;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[0]}, $px, $py;
push @{$results[0]}, $t if defined $type;
}
# below
$py = $ny + $cy + $d;
$t = $flags->[$idx++];
for my $x (0 .. $cx)
{
$px = $x + $nx;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[1]}, $px, $py;
push @{$results[1]}, $t if defined $type;
}
# left
$px = $nx - $d;
$t = $flags->[$idx++];
for my $y (0 .. $cy)
{
$py = $y + $ny;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[2]}, $px, $py;
push @{$results[2]}, $t if defined $type;
}
# top
$py = $ny - $d;
$t = $flags->[$idx];
for my $x (0 .. $cx)
{
$px = $x + $nx;
next if exists $cells->{"$px,$py"} && !$loose;
push @{$results[3]}, $px, $py;
push @{$results[3]}, $t if defined $type;
}
# accumulate the results in the requested, shuffled order
for my $i (0..3)
{
my $idx = $index->[$i] / 3;
push @places, @{$results[$idx]};
}
@places;
}
sub _allowed_places
{
# given a list of potential positions, and a list of allowed positions,
# return the valid ones (e.g. that are in both lists)
my ($self, $places, $allowed, $step) = @_;
print STDERR
"# calculating allowed places for $self->{name} from " . @$places .
" positions and " . scalar @$allowed . " allowed ones:\n"
if $self->{graph}->{debug};
$step ||= 2; # default: "x,y"
my @good;
my $i = 0;
while ($i < @$places)
{
my ($x,$y) = ($places->[$i], $places->[$i+1]);
my $allow = 0;
my $j = 0;
while ($j < @$allowed)
{
my ($m,$n) = ($allowed->[$j], $allowed->[$j+1]);
$allow++ and last if ($m == $x && $n == $y);
} continue { $j += 2; }
next unless $allow;
push @good, $places->[$i + $_ -1] for (1..$step);
} continue { $i += $step; }
print STDERR "# left with " . ((scalar @good) / $step) . " position(s)\n" if $self->{graph}->{debug};
@good;
}
sub _allow
{
# return a list of places, depending on the start/end attribute:
# "south" - any place south
# "south,0" - first place south
# "south,-1" - last place south
# XXX TODO:
# "south,0..2" - first three places south
# "south,0,1,-1" - first, second and last place south
my ($self, $dir, @pos) = @_;
# for relative direction, get the absolute flow from the node
if ($dir =~ /^(front|forward|back|left|right)\z/)
{
# get the flow at the node
$dir = $self->flow();
}
my $place = {
'south' => [ 0,0, 0,1, 'cx', 1,0 ],
'north' => [ 0,-1, 0,0, 'cx', 1,0 ],
'east' => [ 0,0, 1,0, 'cy', 0,1 ],
'west' => [ -1,0, 0,0, 'cy', 0,1 ] ,
180 => [ 0,0, 0,1, 'cx', 1,0 ],
0 => [ 0,-1, 0,0, 'cx', 1,0 ],
90 => [ 0,0, 1,0, 'cy', 0,1 ],
270 => [ -1,0, 0,0, 'cy', 0,1 ] ,
};
my $p = $place->{$dir};
return [] unless defined $p;
# start pos
my $x = $p->[0] + $self->{x} + $p->[2] * $self->{cx};
my $y = $p->[1] + $self->{y} + $p->[3] * $self->{cy};
my @allowed;
push @pos, '' if @pos == 0;
my $c = $p->[4];
if (@pos == 1 && $pos[0] eq '')
{
# allow all of them
for (1 .. $self->{$c})
{
push @allowed, $x, $y;
$x += $p->[5];
$y += $p->[6];
}
}
else
{
# allow only the given position
my $ps = $pos[0];
# limit to 0..$self->{cx}-1
$ps = $self->{$c} + $ps if $ps < 0;
$ps = 0 if $ps < 0;
$ps = $self->{$c} - 1 if $ps >= $self->{$c};
$x += $p->[5] * $ps;
$y += $p->[6] * $ps;
push @allowed, $x, $y;
}
\@allowed;
}
package Graph::Easy;
use strict;
use Graph::Easy::Node::Cell;
use Graph::Easy::Edge::Cell qw/
EDGE_HOR EDGE_VER EDGE_CROSS
EDGE_TYPE_MASK
EDGE_HOLE
/;
sub _clear_tries
{
# Take a list of potential positions for a node, and then remove the
# ones that are immediately near any other node.
# Returns a list of "good" positions. Afterwards $node->{x} is undef.
my ($self, $node, $cells, $tries) = @_;
my $src = 0; my @new;
print STDERR "# clearing ", scalar @$tries / 2, " tries for $node->{name}\n" if $self->{debug};
my $node_grandpa = $node->find_grandparent();
while ($src < scalar @$tries)
{
# check the current position
# temporary place node here
my $x = $tries->[$src];
my $y = $tries->[$src+1];
# print STDERR "# checking $x,$y\n" if $self->{debug};
$node->{x} = $x;
$node->{y} = $y;
my @near = $node->_near_places($cells, 1, undef, 1);
# push also the four corner cells to avoid placing nodes corner-to-corner
push @near, $x-1, $y-1, # upperleft corner
$x-1, $y+($node->{cy}||1), # lowerleft corner
$x+($node->{cx}||1), $y+($node->{cy}||1), # lowerright corner
$x+($node->{cx}||1), $y-1; # upperright corner
# check all near places to be free from nodes (except our children)
my $j = 0; my $g = 0;
while ($j < @near)
{
my $xy = $near[$j]. ',' . $near[$j+1];
# print STDERR "# checking near-place: $xy: " . ref($cells->{$xy}) . "\n" if $self->{debug};
my $cell = $cells->{$xy};
# skip, unless we are a children of node, or the cell is our children
next unless ref($cell) && $cell->isa('Graph::Easy::Node');
my $grandpa = $cell->find_grandparent();
# this cell is our children
# this cell is our grandpa
# has the same grandpa as node
next if $grandpa == $node || $cell == $node_grandpa || $grandpa == $node_grandpa;
$g++; last;
} continue { $j += 2; }
if ($g == 0)
{
push @new, $tries->[$src], $tries->[$src+1];
}
$src += 2;
}
$node->{x} = undef;
@new;
}
my $flow_shift = {
270 => [ 0, -1 ],
90 => [ 0, 1 ],
0 => [ 1, 0 ],
180 => [ -1, 0 ],
};
sub _placed_shared
{
# check whether one of the nodes from the list of shared was already placed
my ($self) = shift;
my $placed;
for my $n (@_)
{
$placed = [$n->{x}, $n->{y}] and last if defined $n->{x};
}
$placed;
}
use Graph::Easy::Util qw(first_kv);
sub _find_node_place
{
# Try to place a node (or node cluster). Return score (usually 0).
my ($self, $node, $try, $parent, $edge) = @_;
$try ||= 0;
print STDERR "# Finding place for $node->{name}, try #$try\n" if $self->{debug};
print STDERR "# Parent node is '$parent->{name}'\n" if $self->{debug} && ref $parent;
print STDERR "# called from ". join (" ", caller) . "\n" if $self->{debug};
# If the node has a user-set rank, see if we already placed another node in that
# row/column
if ($node->{rank} >= 0)
{
my $r = abs($node->{rank});
# print STDERR "# User-set rank for $node->{name} (rank $r)\n";
my $c = $self->{_rank_coord};
# use Data::Dumper; print STDERR "# rank_pos: \n", Dumper($self->{_rank_pos});
if (exists $self->{_rank_pos}->{ $r })
{
my $co = { x => 0, y => 0 };
$co->{$c} = $self->{_rank_pos}->{ $r };
while (1 < 3)
{
# print STDERR "# trying to force placement of '$node->{name}' at $co->{x} $co->{y}\n";
return 0 if $node->_do_place($co->{x},$co->{y},$self);
$co->{$c} += 2;
}
}
}
my $cells = $self->{cells};
# local $self->{debug} = 1;
my $min_dist = 2;
# minlen = 0 => min_dist = 2,
# minlen = 1 => min_dist = 2,
# minlen = 2 => min_dist = 3, etc
$min_dist = $edge->attribute('minlen') + 1 if ref($edge);
# if the node has outgoing edges (which might be shared)
if (!ref($edge))
{
(undef,$edge) = first_kv($node->{edges}) if keys %{$node->{edges}} > 0;
}
my $dir = undef; $dir = $edge->flow() if ref($edge);
my @tries;
# if (ref($parent) && defined $parent->{x})
if (keys %{$node->{edges}} > 0)
{
my $src_node = $parent; $src_node = $edge->{from} if ref($edge) && !ref($parent);
print STDERR "# from $src_node->{name} to $node->{name}: edge $edge dir $dir\n" if $self->{debug};
# if there are more than one edge to this node, and they share a start point,
# move the node at least 3 cells away to create space for the joints
my ($s_p, @ss_p);
($s_p, @ss_p) = $edge->port('start') if ref($edge);
my ($from,$to);
if (ref($edge))
{
$from = $edge->{from}; $to = $edge->{to};
}
my @shared_nodes;
@shared_nodes = $from->nodes_sharing_start($s_p,@ss_p) if defined $s_p && @ss_p > 0;
print STDERR "# Edge from '$src_node->{name}' shares an edge start with ", scalar @shared_nodes, " other nodes\n"
if $self->{debug};
if (@shared_nodes > 1)
{
$min_dist = 3 if $min_dist < 3; # make space
$min_dist++ if $edge->label() ne ''; # make more space for the label
# if we are the first shared node to be placed
my $placed = $self->_placed_shared(@shared_nodes);
if (defined $placed)
{
# we are not the first, so skip the placement below
# instead place on the same column/row as already placed node(s)
my ($bx, $by) = @$placed;
my $flow = $node->flow();
print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
if $self->{debug};
my $ofs = 2; # start with a distance of 2
my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
while (1)
{
my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
if $self->{debug};
next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
last if $node->_do_place($x,$y,$self);
}
continue {
$ofs += 2;
}
return 0; # found place already
} # end we-are-the-first-to-be-placed
}
# shared end point?
($s_p, @ss_p) = $edge->port('end') if ref($edge);
@shared_nodes = $to->nodes_sharing_end($s_p,@ss_p) if defined $s_p && @ss_p > 0;
print STDERR "# Edge from '$src_node->{name}' shares an edge end with ", scalar @shared_nodes, " other nodes\n"
if $self->{debug};
if (@shared_nodes > 1)
{
$min_dist = 3 if $min_dist < 3;
$min_dist++ if $edge->label() ne ''; # make more space for the label
# if the node to be placed is not in the list to be placed, it is the end-point
# see if we are the first shared node to be placed
my $placed = $self->_placed_shared(@shared_nodes);
# print STDERR "# "; for (@shared_nodes) { print $_->{name}, " "; } print "\n";
if ((grep( $_ == $node, @shared_nodes)) && defined $placed)
{
# we are not the first, so skip the placement below
# instead place on the same column/row as already placed node(s)
my ($bx, $by) = @$placed;
my $flow = $node->flow();
print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
if $self->{debug};
my $ofs = 2; # start with a distance of 2
my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
while (1)
{
my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
if $self->{debug};
next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
last if $node->_do_place($x,$y,$self);
}
continue {
$ofs += 2;
}
return 0; # found place already
} # end we-are-the-first-to-be-placed
}
}
if (ref($parent) && defined $parent->{x})
{
@tries = $parent->_near_places($cells, $min_dist, undef, 0, $dir);
print STDERR
"# Trying chained placement of $node->{name} with min distance $min_dist from parent $parent->{name}\n"
if $self->{debug};
# weed out positions that are unsuitable
@tries = $self->_clear_tries($node, $cells, \@tries);
splice (@tries,0,$try) if $try > 0; # remove the first N tries
print STDERR "# Left with " . scalar @tries . " tries for node $node->{name}\n" if $self->{debug};
while (@tries > 0)
{
my $x = shift @tries;
my $y = shift @tries;
print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
return 0 if $node->_do_place($x,$y,$self);
} # for all trial positions
}
print STDERR "# Trying to place $node->{name} at 0,0\n" if $try == 0 && $self->{debug};
# Try to place node at upper left corner (the very first node to be
# placed will usually end up there).
return 0 if $try == 0 && $node->_do_place(0,0,$self);
# try to place node near the predecessor(s)
my @pre_all = $node->predecessors();
print STDERR "# Predecessors of $node->{name} " . scalar @pre_all . "\n" if $self->{debug};
# find all already placed predecessors
my @pre;
for my $p (@pre_all)
{
push @pre, $p if defined $p->{x};
print STDERR "# Placed predecessors of $node->{name}: $p->{name} at $p->{x},$p->{y}\n" if $self->{debug} && defined $p->{x};
}
# sort predecessors on their rank (to try first the higher ranking ones on placement)
@pre = sort { $b->{rank} <=> $a->{rank} } @pre;
print STDERR "# Number of placed predecessors of $node->{name}: " . scalar @pre . "\n" if $self->{debug};
if (@pre <= 2 && @pre > 0)
{
if (@pre == 1)
{
# only one placed predecessor, so place $node near it
print STDERR "# placing $node->{name} near predecessor\n" if $self->{debug};
@tries = ( $pre[0]->_near_places($cells, $min_dist), $pre[0]->_near_places($cells,$min_dist+2) );
}
else
{
# two placed predecessors, so place at crossing point of both of them
# compute difference between the two nodes
my $dx = ($pre[0]->{x} - $pre[1]->{x});
my $dy = ($pre[0]->{y} - $pre[1]->{y});
# are both nodes NOT on a straight line?
if ($dx != 0 && $dy != 0)
{
# ok, so try to place at the crossing point
@tries = (
$pre[0]->{x}, $pre[1]->{y},
$pre[0]->{y}, $pre[1]->{x},
);
}
else
{
# two nodes on a line, try to place node in the middle
if ($dx == 0)
{
@tries = ( $pre[1]->{x}, $pre[1]->{y} + int($dy / 2) );
}
else
{
@tries = ( $pre[1]->{x} + int($dx / 2), $pre[1]->{y} );
}
}
# XXX TODO BUG: shouldn't we also try this if we have more than 2
# placed predecessors?
# In addition, we can also try to place the node around the
# different nodes:
foreach my $n (@pre)
{
push @tries, $n->_near_places($cells, $min_dist);
}
}
}
my @suc_all = $node->successors();
# find all already placed successors
my @suc;
for my $s (@suc_all)
{
push @suc, $s if defined $s->{x};
}
print STDERR "# Number of placed successors of $node->{name}: " . scalar @suc . "\n" if $self->{debug};
foreach my $s (@suc)
{
# for each successors (especially if there is only one), try to place near
push @tries, $s->_near_places($cells, $min_dist);
push @tries, $s->_near_places($cells, $min_dist + 2);
}
# weed out positions that are unsuitable
@tries = $self->_clear_tries($node, $cells, \@tries);
print STDERR "# Left with " . scalar @tries . " for node $node->{name}\n" if $self->{debug};
splice (@tries,0,$try) if $try > 0; # remove the first N tries
while (@tries > 0)
{
my $x = shift @tries;
my $y = shift @tries;
print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
return 0 if $node->_do_place($x,$y,$self);
} # for all trial positions
##############################################################################
# all simple possibilities exhausted, try a generic approach
print STDERR "# No more simple possibilities for node $node->{name}\n" if $self->{debug};
# XXX TODO:
# find out which sides of the node predecessor node(s) still have free
# ports/slots. With increasing distances, try to place the node around these.
# If no predecessors/incoming edges, try to place in column 0, otherwise
# considered the node's rank, too
my $col = 0; $col = $node->{rank} * 2 if @pre > 0;
$col = $pre[0]->{x} if @pre > 0;
# find the first free row
my $y = 0;
$y +=2 while (exists $cells->{"$col,$y"});
$y += 1 if exists $cells->{"$col," . ($y-1)}; # leave one cell spacing
# now try to place node (or node cluster)
while (1)
{
next if $self->_clear_tries($node, $cells, [ $col,$y ]) == 0;
last if $node->_do_place($col,$y,$self);
}
continue {
$y += 2;
}
$node->{x} = $col;
0; # success, score 0
}
sub _trace_path
{
# find a free way from $src to $dst (both need to be placed beforehand)
my ($self, $src, $dst, $edge) = @_;
print STDERR "# Finding path from '$src->{name}' to '$dst->{name}'\n" if $self->{debug};
print STDERR "# src: $src->{x}, $src->{y} dst: $dst->{x}, $dst->{y}\n" if $self->{debug};
my $coords = $self->_find_path ($src, $dst, $edge);
# found no path?
if (!defined $coords)
{
print STDERR "# Unable to find path from $src->{name} ($src->{x},$src->{y}) to $dst->{name} ($dst->{x},$dst->{y})\n" if $self->{debug};
return undef;
}
# path is empty, happens for sharing edges with only a joint
return 1 if scalar @$coords == 0;
# Create all cells from the returned list and score path (lower score: better)
my $i = 0;
my $score = 0;
while ($i < scalar @$coords)
{
my $type = $coords->[$i+2];
$self->_create_cell($edge,$coords->[$i],$coords->[$i+1],$type);
$score ++; # each element: one point
$type &= EDGE_TYPE_MASK; # mask flags
# edge bend or cross: one point extra
$score ++ if $type != EDGE_HOR && $type != EDGE_VER;
$score += 3 if $type == EDGE_CROSS; # crossings are doubleplusungood
$i += 3;
}
$score;
}
sub _create_cell
{
my ($self,$edge,$x,$y,$type) = @_;
my $cells = $self->{cells}; my $xy = "$x,$y";
if (ref($cells->{$xy}) && $cells->{$xy}->isa('Graph::Easy::Edge'))
{
$cells->{$xy}->_make_cross($edge,$type & EDGE_FLAG_MASK);
# insert a EDGE_HOLE into the cells of the edge (but not into the list of
# to-be-rendered cells). This cell will be removed by the optimizer later on.
Graph::Easy::Edge::Cell->new( type => EDGE_HOLE, edge => $edge, x => $x, y => $y );
return;
}
my $path = Graph::Easy::Edge::Cell->new( type => $type, edge => $edge, x => $x, y => $y );
$cells->{$xy} = $path; # store in cells
}
sub _path_is_clear
{
# For all points (x,y pairs) in the path, check that the cell is still free
# $path points to a list of [ x,y,type, x,y,type, ...]
my ($self,$path) = @_;
my $cells = $self->{cells};
my $i = 0;
while ($i < scalar @$path)
{
my $x = $path->[$i];
my $y = $path->[$i+1];
# my $t = $path->[$i+2];
$i += 3;
return 0 if exists $cells->{"$x,$y"}; # obstacle hit
}
1; # path is clear
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Path - Path management for Manhattan-style grids
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Scout> contains just the actual path-managing code for
L<Graph::Easy|Graph::Easy>, e.g. to create/destroy/maintain paths, node
placement etc.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 METHODS into Graph::Easy
This module injects the following methods into C<Graph::Easy>:
=head2 _path_is_clear()
$graph->_path_is_clear($path);
For all points (x,y pairs) in the path, check that the cell is still free.
C<$path> points to a list x,y,type pairs as in C<< [ [x,y,type], [x,y,type], ...] >>.
=head2 _create_cell()
my $cell = $graph->($edge,$x,$y,$type);
Create a cell at C<$x,$y> coordinates with type C<$type> for the specified
edge.
=head2 _path_is_clear()
$graph->_path_is_clear();
For all points (x,y pairs) in the path, check that the cell is still free.
C<$path> points to a list of C<[ x,y,type, x,y,type, ...]>.
Returns true when the path is clear, false otherwise.
=head2 _trace_path()
my $path = my $graph->_trace_path($src,$dst,$edge);
Find a free way from source node/group to destination node/group for the
specified edge. Both source and destination need to be placed beforehand.
=head1 METHODS in Graph::Easy::Node
This module injects the following methods into C<Graph::Easy::Node>:
=head2 _near_places()
my $node->_near_places();
Take a node and return a list of possible placements around it and
prune out already occupied cells. $d is the distance from the node
border and defaults to two (for placements). Set it to one for
adjacent cells.
=head2 _shuffle_dir()
my $dirs = $node->_shuffle_dir( [ 0,1,2,3 ], $dir);
Take a ref to an array with four entries and shuffle them around according to
C<$dir>.
=head2 _shift()
my $dir = $node->_shift($degrees);
Return a the C<flow()> direction shifted by X degrees to C<$dir>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for information.
=cut

649
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Repair.pm Normal file
View File

@@ -0,0 +1,649 @@
#############################################################################
# Layout directed graphs on a flat plane. Part of Graph::Easy.
#
# Code to repair spliced layouts (after group cells have been inserted).
#
#############################################################################
package Graph::Easy::Layout::Repair;
$VERSION = '0.76';
#############################################################################
#############################################################################
# for layouts with groups:
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Util qw(ord_values);
sub _edges_into_groups
{
my $self = shift;
# Put all edges between two nodes with the same group in the group as well
for my $edge (ord_values $self->{edges})
{
my $gf = $edge->{from}->group();
my $gt = $edge->{to}->group();
$gf->_add_edge($edge) if defined $gf && defined $gt && $gf == $gt;
}
$self;
}
sub _repair_nodes
{
# Splicing the rows/columns to add filler cells will have torn holes into
# multi-edges nodes, so we insert additional filler cells.
my ($self) = @_;
my $cells = $self->{cells};
# Make multi-celled nodes occupy the proper double space due to splicing
# in group cell has doubled the layout in each direction:
for my $n ($self->nodes())
{
# 1 => 1, 2 => 3, 3 => 5, 4 => 7 etc
$n->{cx} = $n->{cx} * 2 - 1;
$n->{cy} = $n->{cy} * 2 - 1;
}
# We might get away with not inserting filler cells if we just mark the
# cells as used (e.g. use only one global filler cell) since filler cells
# aren't actually rendered, anyway.
for my $cell (ord_values $cells)
{
next unless $cell->isa('Graph::Easy::Node::Cell');
# we have "[ empty ] [ filler ]" (unless cell is on the same column as node)
if ($cell->{x} > $cell->{node}->{x})
{
my $x = $cell->{x} - 1; my $y = $cell->{y};
# print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
$cells->{"$x,$y"} =
Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
}
# we have " [ empty ] "
# " [ filler ] " (unless cell is on the same row as node)
if ($cell->{y} > $cell->{node}->{y})
{
my $x = $cell->{x}; my $y = $cell->{y} - 1;
# print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
$cells->{"$x,$y"} =
Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
}
}
}
sub _repair_cell
{
my ($self, $type, $edge, $x, $y, $after, $before) = @_;
# already repaired?
return if exists $self->{cells}->{"$x,$y"};
# print STDERR "# Insert edge cell at $x,$y (type $type) for edge $edge->{from}->{name} --> $edge->{to}->{name}\n";
$self->{cells}->{"$x,$y"} =
Graph::Easy::Edge::Cell->new(
type => $type,
edge => $edge, x => $x, y => $y, before => $before, after => $after );
}
sub _splice_edges
{
# Splicing the rows/columns to add filler cells might have torn holes into
# edges, so we splice these together again.
my ($self) = @_;
my $cells = $self->{cells};
print STDERR "# Reparing spliced layout\n" if $self->{debug};
# Edge end/start points inside groups are not handled here, but in
# _repair_group_edge()
# go over the old layout, because the new cells were inserted into odd
# rows/columns and we do not care for these:
for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
{
next unless $cell->isa('Graph::Easy::Edge::Cell');
my $edge = $cell->{edge};
#########################################################################
# check for "[ JOINT ] [ empty ] [ edge ]"
my $x = $cell->{x} + 2; my $y = $cell->{y};
my $type = $cell->{type} & EDGE_TYPE_MASK;
# left is a joint and right exists
if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_E_N_S)
&& exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x,$y"};
# print STDERR "# at $x,$y\n";
# |-> [ empty ] [ node ]
if ($right->isa('Graph::Easy::Edge::Cell'))
{
# when the left one is a joint, the right one must be an edge
$self->error("Found non-edge piece ($right->{type} $right) right to a joint ($type)")
unless $right->isa('Graph::Easy::Edge::Cell');
# print STDERR "splicing in HOR piece to the right of joint at $x, $y ($edge $right $right->{edge})\n";
# insert the new piece before the first part of the edge after the joint
$self->_repair_cell(EDGE_HOR(), $right->{edge},$cell->{x}+1,$y,0)
if $edge != $right->{edge};
}
}
#########################################################################
# check for "[ edge ] [ empty ] [ joint ]"
$x = $cell->{x} - 2; $y = $cell->{y};
# right is a joint and left exists
if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_W_N_S)
&& exists $cells->{"$x,$y"})
{
my $left = $cells->{"$x,$y"};
# [ node ] [ empty ] [ <-| ]
if (!$left->isa('Graph::Easy::Node'))
{
# when the left one is a joint, the right one must be an edge
$self->error('Found non-edge piece right to a joint')
unless $left->isa('Graph::Easy::Edge::Cell');
# insert the new piece before the joint
$self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,0) # $left,$cell)
if $edge != $left->{edge};
}
}
#########################################################################
# check for " [ joint ]
# [ empty ]
# [ edge ]"
$x = $cell->{x}; $y = $cell->{y} + 2;
# top is a joint and down exists
if ( ($type == EDGE_S_E_W || $type == EDGE_E_N_S || $type == EDGE_W_N_S)
&& exists $cells->{"$x,$y"})
{
my $bottom = $cells->{"$x,$y"};
# when top is a joint, the bottom one must be an edge
$self->error('Found non-edge piece below a joint')
unless $bottom->isa('Graph::Easy::Edge::Cell');
# print STDERR "splicing in VER piece below joint at $x, $y\n";
# XXX TODO
# insert the new piece after the joint
$self->_repair_cell(EDGE_VER(), $bottom->{edge},$x,$cell->{y}+1,0)
if $edge != $bottom->{edge};
}
#########################################################################
# check for "[ --- ] [ empty ] [ ---> ]"
$x = $cell->{x} + 2; $y = $cell->{y};
if (exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x,$y"};
$self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,$cell,$right)
if $right->isa('Graph::Easy::Edge::Cell') &&
defined $right->{edge} && defined $right->{type} &&
# check that both cells belong to the same edge
( $edge == $right->{edge} ||
# or the right part is a cross
$right->{type} == EDGE_CROSS ||
# or the left part is a cross
$cell->{type} == EDGE_CROSS );
}
#########################################################################
# check for [ | ]
# [ empty ]
# [ | ]
$x = $cell->{x}; $y = $cell->{y}+2;
if (exists $cells->{"$x,$y"})
{
my $below = $cells->{"$x,$y"};
$self->_repair_cell(EDGE_VER(),$edge,$x,$cell->{y}+1,$cell,$below)
if $below->isa('Graph::Easy::Edge::Cell') &&
# check that both cells belong to the same edge
( $edge == $below->{edge} ||
# or the lower part is a cross
$below->{type} == EDGE_CROSS ||
# or the upper part is a cross
$cell->{type} == EDGE_CROSS );
}
} # end for all cells
$self;
}
sub _new_edge_cell
{
# create a new edge cell to be spliced into the layout for repairs
my ($self, $cells, $group, $edge, $x, $y, $after, $type) = @_;
$type += EDGE_SHORT_CELL() if defined $group;
my $e_cell = Graph::Easy::Edge::Cell->new(
type => $type, edge => $edge, x => $x, y => $y, after => $after);
$group->_del_cell($e_cell) if defined $group;
$cells->{"$x,$y"} = $e_cell;
}
sub _check_edge_cell
{
# check a start/end edge cell and if nec. repair it
my ($self, $cell, $x, $y, $flag, $type, $match, $check, $where) = @_;
my $edge = $cell->{edge};
if (grep { exists $_->{cell_class} && $_->{cell_class} =~ $match } ord_values ($check))
{
$cell->{type} &= ~ $flag; # delete the flag
$self->_new_edge_cell(
$self->{cells}, $edge->{group}, $edge, $x, $y, $where, $type + $flag);
}
}
sub _repair_group_edge
{
# repair an edges inside a group
my ($self, $cell, $rows, $cols, $group) = @_;
my $cells = $self->{cells};
my ($x,$y,$doit);
my $type = $cell->{type};
#########################################################################
# check for " [ empty ] [ |---> ]"
$x = $cell->{x} - 1; $y = $cell->{y};
$self->_check_edge_cell($cell, $x, $y, EDGE_START_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_W);
#########################################################################
# check for " [ <--- ] [ empty ]"
$x = $cell->{x} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_E);
#########################################################################
# check for " [ --> ] [ empty ]"
$x = $cell->{x} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_E);
# $self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_E_N_S, qr/g[rl]/, $cols->{$x}, -1)
# if (($type & EDGE_END_MASK) == EDGE_END_E);
#########################################################################
# check for " [ empty ] [ <-- ]"
$x = $cell->{x} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_W);
#########################################################################
#########################################################################
# vertical cases
#########################################################################
# check for [empty]
# [ | ]
$x = $cell->{x}; $y = $cell->{y} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_N);
#########################################################################
# check for [ |]
# [ empty ]
$y = $cell->{y} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_START_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
if (($type & EDGE_START_MASK) == EDGE_START_S);
#########################################################################
# check for [ v ]
# [empty]
$y = $cell->{y} + 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_S);
#########################################################################
# check for [ empty ]
# [ ^ ]
$y = $cell->{y} - 1;
$self->_check_edge_cell($cell, $x, $y, EDGE_END_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
if (($type & EDGE_END_MASK) == EDGE_END_N);
}
sub _repair_edge
{
# repair an edge outside a group
my ($self, $cell, $rows, $cols) = @_;
my $cells = $self->{cells};
#########################################################################
# check for [ |\n|\nv ]
# [empty] ... [non-empty]
# [node]
my $x = $cell->{x}; my $y = $cell->{y} + 1;
my $below = $cells->{"$x,$y"}; # must be empty
if (!ref($below) && (($cell->{type} & EDGE_END_MASK) == EDGE_END_S))
{
if (grep { exists $_->{cell_class} && $_->{cell_class} =~ /g[tb]/ } ord_values $rows->{$y})
{
# delete the start flag
$cell->{type} &= ~ EDGE_END_S;
$self->_new_edge_cell($cells, undef, $cell->{edge}, $x, $y, -1,
EDGE_VER() + EDGE_END_S() );
}
}
# XXX TODO: do the other ends (END_N, END_W, END_E), too
}
sub _repair_edges
{
# fix edge end/start cells to be closer to the node cell they point at
my ($self, $rows, $cols) = @_;
my $cells = $self->{cells};
# go over all existing cells
for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
{
next unless $cell->isa('Graph::Easy::Edge::Cell');
# skip odd positions
next unless ($cell->{x} & 1) == 0 && ($cell->{y} & 1) == 0;
my $group = $cell->group();
$self->_repair_edge($cell,$rows,$cols) unless $group;
$self->_repair_group_edge($cell,$rows,$cols,$group) if $group;
} # end for all cells
}
sub _fill_group_cells
{
# after doing a layout(), we need to add the group to each cell based on
# what group the nearest node is in.
my ($self, $cells_layout) = @_;
print STDERR "\n# Padding with fill cells, have ",
scalar $self->groups(), " groups.\n" if $self->{debug};
# take a shortcut if we do not have groups
return $self if $self->groups == 0;
$self->{padding_cells} = 1; # set to true
# We need to insert "filler" cells around each node/edge/cell:
# To "insert" the filler cells, we simple multiply each X and Y by 2, this
# is O(N) where N is the number of actually existing cells. Otherwise we
# would have to create the full table-layout, and then insert rows/columns.
my $cells = {};
for my $key (sort keys %$cells_layout)
{
my ($x,$y) = split /,/, $key;
my $cell = $cells_layout->{$key};
$x *= 2;
$y *= 2;
$cell->{x} = $x;
$cell->{y} = $y;
$cells->{"$x,$y"} = $cell;
}
$self->{cells} = $cells; # override with new cell layout
$self->_splice_edges(); # repair edges
$self->_repair_nodes(); # repair multi-celled nodes
my $c = 'Graph::Easy::Group::Cell';
for my $cell (ord_values $self->{cells})
{
# DO NOT MODIFY $cell IN THE LOOP BODY!
my ($x,$y) = ($cell->{x},$cell->{y});
# find the primary node for node cells, for group check
my $group = $cell->group();
# not part of group, so no group-cells nec.
next unless $group;
# now insert up to 8 filler cells around this cell
my $ofs = [ -1, 0,
0, -1,
+1, 0,
+1, 0,
0, +1,
0, +1,
-1, 0,
-1, 0, ];
while (@$ofs > 0)
{
$x += shift @$ofs;
$y += shift @$ofs;
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y )
unless exists $cells->{"$x,$y"};
}
}
# Nodes positioned two cols/rows apart (f.i. y == 0 and y == 2) will be
# three cells apart (y == 0 and y == 4) after the splicing, the step above
# will not be able to close that hole - it will create fillers at y == 1 and
# y == 3. So we close these holes now with an extra step.
for my $cell (ord_values ( $self->{cells} ))
{
# only for filler cells
next unless $cell->isa('Graph::Easy::Group::Cell');
my ($sx,$sy) = ($cell->{x},$cell->{y});
my $group = $cell->{group};
my $x = $sx; my $y2 = $sy + 2; my $y = $sy + 1;
# look for:
# [ group ]
# [ empty ]
# [ group ]
if (exists $cells->{"$x,$y2"} && !exists $cells->{"$x,$y"})
{
my $down = $cells->{"$x,$y2"};
if ($down->isa('Graph::Easy::Group::Cell') && $down->{group} == $group)
{
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
}
}
$x = $sx+1; my $x2 = $sx + 2; $y = $sy;
# look for:
# [ group ] [ empty ] [ group ]
if (exists $cells->{"$x2,$y"} && !exists $cells->{"$x,$y"})
{
my $right = $cells->{"$x2,$y"};
if ($right->isa('Graph::Easy::Group::Cell') && $right->{group} == $group)
{
$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
}
}
}
# XXX TODO
# we should "grow" the group area to close holes
for my $group (ord_values ( $self->{groups} ))
{
$group->_set_cell_types($cells);
}
# create a mapping for each row/column so that we can repair edge starts/ends
my $rows = {};
my $cols = {};
for my $cell (ord_values ($cells))
{
$rows->{$cell->{y}}->{$cell->{x}} = $cell;
$cols->{$cell->{x}}->{$cell->{y}} = $cell;
}
$self->_repair_edges($rows,$cols); # insert short edge cells on group
# border rows/columns
# for all groups, set the cell carrying the label (top-left-most cell)
for my $group (ord_values ( $self->{groups} ))
{
$group->_find_label_cell();
}
# DEBUG:
# for my $cell (ord_values $cells)
# {
# $cell->_correct_size();
# }
#
# my $y = 0;
# for my $cell (sort { $a->{y} <=> $b->{y} || $a->{x} <=> $b->{x} } values %$cells)
# {
# print STDERR "\n" if $y != $cell->{y};
# print STDERR "$cell->{x},$cell->{y}, $cell->{w},$cell->{h}, ", $cell->{group}->{name} || 'none', "\t";
# $y = $cell->{y};
# }
# print STDERR "\n";
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Layout::Repair - Repair spliced layout with group cells
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout::Repair> contains code that can splice in
group cells into a layout, as well as repair the layout after that step.
It is part of L<Graph::Easy|Graph::Easy> and used automatically.
=head1 METHODS
C<Graph::Easy::Layout> injects the following methods into the C<Graph::Easy>
namespace:
=head2 _edges_into_groups()
Put the edges into the appropriate group and class.
=head2 _assign_ranks()
$graph->_assign_ranks();
=head2 _repair_nodes()
Splicing the rows/columns to add filler cells will have torn holes into
multi-edges nodes, so we insert additional filler cells to repair this.
=head2 _splice_edges()
Splicing the rows/columns to add filler cells might have torn holes into
multi-celled edges, so we splice these together again.
=head2 _repair_edges()
Splicing the rows/columns to add filler cells might have put "holes"
between an edge start/end and the node cell it points to. This
routine fixes this problem by extending the edge by one cell if
necessary.
=head2 _fill_group_cells()
After doing a C<layout()>, we need to add the group to each cell based on
what group the nearest node is in.
This routine will also find the label cell for each group, and repair
edge/node damage done by the splicing.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut

1717
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Layout/Scout.pm Normal file
View File

File diff suppressed because it is too large Load Diff

2865
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Node.pm Normal file
View File

File diff suppressed because it is too large Load Diff

116
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Node/Anon.pm Normal file
View File

@@ -0,0 +1,116 @@
#############################################################################
# (c) by Tels 2004. Part of Graph::Easy. An anonymous (invisible) node.
#
#############################################################################
package Graph::Easy::Node::Anon;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
sub _init
{
my $self = shift;
$self->SUPER::_init(@_);
$self->{name} = '#' . $self->{id};
$self->{class} = 'node.anon';
$self->{att}->{label} = ' ';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
sub attributes_as_txt
{
my $self = shift;
$self->SUPER::attributes_as_txt( {
node => {
label => undef,
shape => undef,
class => undef,
} } );
}
sub as_pure_txt
{
'[ ]';
}
sub _as_part_txt
{
'[ ]';
}
sub as_txt
{
my $self = shift;
'[ ]' . $self->attributes_as_txt();
}
sub text_styles_as_css
{
'';
}
sub is_anon
{
# is an anon node
1;
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Anon - An anonymous, invisible node in Graph::Easy
=head1 SYNOPSIS
use Graph::Easy::Node::Anon;
my $anon = Graph::Easy::Node::Anon->new();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Anon> represents an anonymous, invisible node.
These can be used to let edges start and end "nowhere".
The syntax in the Graph::Easy textual description language looks like this:
[ ] -> [ Bonn ] -> [ ]
=head1 EXPORT
None by default.
=head1 SEE ALSO
L<Graph::Easy::Node>.
=head1 AUTHOR
Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

140
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Node/Cell.pm Normal file
View File

@@ -0,0 +1,140 @@
#############################################################################
# (c) by Tels 2004 - 2005. An empty filler cell. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Node::Cell;
use Graph::Easy::Node;
use strict;
use warnings;
use vars qw(@ISA $VERSION);
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->{class} = '';
$self->{name} = '';
$self->{'x'} = 0;
$self->{'y'} = 0;
# default: belongs to no node
$self->{node} = undef;
foreach my $k (sort keys %$args)
{
if ($k !~ /^(node|graph|x|y)\z/)
{
require Carp;
Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node::Cell->new()");
}
$self->{$k} = $args->{$k};
}
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 0;
$self->{h} = 0;
$self;
}
sub node
{
# return the node this cell belongs to
my $self = shift;
$self->{node};
}
sub as_ascii
{
'';
}
sub as_html
{
'';
}
sub group
{
my $self = shift;
$self->{node}->group();
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Cell - An empty filler cell
=head1 SYNOPSIS
use Graph::Easy;
use Graph::Easy::Edge;
my $graph = Graph::Easy->new();
my $node = $graph->add_node('A');
my $path = Graph::Easy::Node::Cell->new(
graph => $graph, node => $node,
);
...
print $graph->as_ascii();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Cell> is used to reserve a cell in the grid for nodes
that occupy more than one cell.
You should not need to use this class directly.
=head1 METHODS
=head2 error()
$last_error = $cell->error();
$cvt->error($error); # set new messages
$cvt->error(''); # clear error
Returns the last error message, or '' for no error.
=head2 node()
my $node = $cell->node();
Returns the node this filler cell belongs to.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2005 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

69
perl/lib/Graph-Easy-0.76/lib/Graph/Easy/Node/Empty.pm Normal file
View File

@@ -0,0 +1,69 @@
#############################################################################
# An empty, borderless cell. Part of Graph::Easy.
#
#############################################################################
package Graph::Easy::Node::Empty;
use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;
$VERSION = '0.76';
use strict;
use warnings;
#############################################################################
sub _init
{
# generic init, override in subclasses
my ($self,$args) = @_;
$self->SUPER::_init($args);
$self->{class} = 'node.empty';
$self;
}
sub _correct_size
{
my $self = shift;
$self->{w} = 3;
$self->{h} = 3;
$self;
}
1;
__END__
=head1 NAME
Graph::Easy::Node::Empty - An empty, borderless cell in a node cluster
=head1 SYNOPSIS
my $cell = Graph::Easy::Node::Empty->new();
=head1 DESCRIPTION
A C<Graph::Easy::Node::Empty> represents a borderless, empty cell in
a node cluster. It is mainly used to have an object to render collapsed
borders in ASCII output.
You should not need to use this class directly.
=head1 SEE ALSO
L<Graph::Easy::Node>.
=head1 AUTHOR
Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
See the LICENSE file for more details.
=cut

Some files were not shown because too many files have changed in this diff Show More