#!/usr/bin/env perl
# vim:set ft=perl ts=4 sw=4 et fdm=marker:
use strict;
use warnings;
use File::Slurp;
use YAML::Syck;
use Getopt::Long;
use File::Spec;
use UML::Class::Simple;
my $ext_regex = qr/(?:\.pl|\.pm)$/i;
my $outfile = 'a.png';
my $dot_prog = $ENV{'UMLCLASS_DOT'} || 'dot';
GetOptions(
"color|c=s" => \my $node_color,
"help|h" => \my $help,
"without-inherited-methods" => \my $without_inherited_methods,
"M=s" => \my @preload_modules,
"out|o=s" => \$outfile,
"P|public-only" => \my $public_only,
"pattern|p=s" => \my $pattern,
"recursive|r" => \my $recursive,
"size|s=s" => \my $size,
"dot=s" => \$dot_prog,
"include|I=s" => \my @include_paths,
"exclude|E=s" => \my @exclude_paths,
"no-methods" => \my $no_methods,
"moose-roles" => \my $moose_roles,
"no-inheritance" => \my $no_inheritance,
) or help(1);
#warn "include_paths: @include_paths\n";
#warn "exclude_paths: @exclude_paths\n";
help(0) if $help;
# We need to add the include paths to @INC so that modules will be found
unshift @INC, @include_paths;
# We need preloaded modules to be loaded, really. Not pretended.
foreach my $mod (@preload_modules) {
my $loc = $mod . ".pm";
$loc =~ s{::}{/}gsmx;
eval { require $loc; };
if ($@) { warn "can't pre-load $mod: $@\n"; }
}
my ($width, $height);
if ($size) {
if ($size !~ /(?x) ([\d\.]+) x ([\d\.]+) /) {
die "error: -s or --size option only takes argument like 3.2x5 and 7x3\n";
}
($width, $height) = ($1, $2);
}
my @infiles = sort map { -d $_ ? all_in($_) : $_ } map glob, @ARGV;
my @plfiles = grep { !/(?:\.dot|\.yml)$/i } @infiles;
for my $plfile (@plfiles) {
if (!-e $plfile) {
die "error: input file $plfile not found.\n";
}
}
my $painter;
if (!@plfiles) {
if (@infiles) {
my $file = pop @infiles;
if ($file =~ /\.dot$/i) {
$painter = UML::Class::Simple->new;
$painter->set_dot(read_file($file));
}
elsif ($file =~ /\.yml$/i) {
$painter = UML::Class::Simple->new;
my $dom = LoadFile($file);
$painter->set_dom($dom);
}
}
} else {
if (@plfiles != @infiles) {
die "error: perl source files are not allowed when ",
".yml or .dot files are also given.\n";
}
}
if (!$painter) {
my @classes;
@classes = classes_from_runtime(\@preload_modules, $pattern) if !@plfiles;
push @classes, classes_from_files(\@plfiles, $pattern) if @plfiles;
if (@classes) {
if (@include_paths) {
@classes = grep_by_paths(\@classes, @include_paths);
}
if (@exclude_paths) {
@classes = exclude_by_paths(\@classes, @exclude_paths);
}
if (!@classes) {
die "error: no class found.\n";
}
print join("\n", sort @classes), "\n\n";
$painter = UML::Class::Simple->new(\@classes);
} else {
die "error: no class found.\n";
}
}
$painter->dot_prog($dot_prog);
$painter->public_only($public_only) if $public_only;
$painter->inherited_methods(0) if $without_inherited_methods;
#die "inherited_methods: ", $painter->inherited_methods;
$painter->size($width, $height) if $width and $height;
$painter->node_color($node_color) if $node_color;
#$painter->root_at($root_class) if $root_class;
$painter->display_methods(0) if $no_methods;
$painter->moose_roles($moose_roles) if $moose_roles;
$painter->display_inheritance(0) if $no_inheritance;
my $ext = 'png';
if ($outfile =~ /\.(\w+)$/) { $ext = lc($1); }
if ($ext eq 'png') {
$painter->as_png($outfile);
}
elsif ($ext eq 'gif') {
$painter->as_gif($outfile);
}
elsif ($ext eq 'dot') {
$painter->as_dot($outfile);
}
elsif ($ext eq 'yml') {
my $dom = $painter->as_dom;
DumpFile($outfile, $dom);
}
elsif ($ext eq 'xmi') {
$painter->as_xmi($outfile);
}
else {
die "error: unknown output file format: $ext\n";
}
print "$outfile generated.\n" if $outfile;
sub help {
my $code = shift;
warn <<"_EOC_";
Usage: $0 [-M module] [-o outfile] [-p regex] [infile... indir...]
infile... Perl source files, .pm, .pl, .yml, or .dot file, or
.yml files containing the class info DOM. They're
optional.
indir... Directory containing perl source files. They're
optional too.
Options:
--color color
-c color Set the node color. Defaults to "#f1e1f4".
--dot path Tell it where to find the graphviz program "dot"
--exclude path
-E path
exclude modules that were installed to <path> from
the drawing. multiple -E options are supported.
--help
-h Print this help.
--include path
-I path
Include *only* the classes that were installed to
<path> in the drawing. multiple -I options are supported.
-M module Preload the specified module to runtime.
(multiple -M are supported.)
--moose-roles
Show relationships between Moose::Role packages
and their consumers in the output.
--no-methods
Do not show any method names at all in the output.
--no-inheritance
Do not draw class inheritance relationships in the output.
--out outfile
-o outfile Specify the output file name. it can be one of the
following types: .png, .dot, .xmi and .yml. Defaults
to a.png.
--public-only
Show public methods only.
--pattern regex
-p regex Specify the perl regex as the pattern used to
filter out classes to be drawn.
--recursive
-r Process subdirectories of indir recursively.
--size <w>x<h>
-s <w>x<h> Specify the width and height (in inches) for the
output images. For instance, 3.2x6.3 and 4x8.
--without-inherited-methods
Do not show methods from parent classes.
Report bugs or wishlist to Agent Zhang <agentzh\@gmail.com>.
_EOC_
exit($code);
}
# Stolen directly from 'prove'
sub all_in {
my $start = shift;
my @hits = ();
local *DH;
if ( opendir( DH, $start ) ) {
my @files = sort readdir DH;
closedir DH;
for my $file ( @files ) {
next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
next if $file eq ".svn";
next if $file eq "CVS";
my $currfile = File::Spec->catfile( $start, $file );
if ( -d $currfile ) {
push( @hits, all_in( $currfile ) ) if $recursive;
} else {
push( @hits, $currfile ) if $currfile =~ $ext_regex;
}
}
} else {
warn "$start: $!\n";
}
return @hits;
}
__END__
=head1 NAME
umlclass.pl - Utility to generate UML class diagrams from Perl source or runtime
=head1 SYNOPSIS
$ umlclass.pl -M Foo -o foo.png -p "^Foo::"
$ umlclass.pl -o bar.gif -p "Bar::|Baz::" lib/Bar.pm lib/*/*.pm
$ umlclass.pl -o blah.png -p Blah -r ./blib
$ umlclass.pl --without-inherited-methods -o blah.png -r lib
=head1 DESCRIPTION
This is a simple command-line frontend for the L<UML::Class::Simple> module.
I'll illustrate the usage of this tool via some real-world examples.
=head2 Draw Stevan's Moose
$ umlclass.pl -M Moose -o samples/moose_small.png -p "^(Class::MOP|Moose::)" -s 4x8
This command will generate a simple class diagram in PNG format for the Moose module
with classes having names matching the regex C<"^(Class::MOP|Moose::)">. The image's
width is 4 inches while its height is 8 inches.
We need the -M option here since C<umlclass.pl> needs to preload L<Moose> into the
memory so as to inspect it at runtime.
The graphical output is given below:
=begin html
<img src="http://perlcabal.org/agent/images/moose_small.png">
=end html
(See also L<http://perlcabal.org/agent/images/moose_small.png>.)
Yes, the image above looks very fuzzy since the whole stuff is huge. If you strip
the -s option, then the resulting image will enlarge automatically:
$ umlclass.pl -M Moose -o samples/moose_big.png -p "^(Class::MOP|Moose::)"
The image obtained is really really large, I won't show it here, but you
can browse it in your favorite picture browser from
L<http://perlcabal.org/agent/images/moose_big.png>.
Before trying out these commands yourself, please make sure that you have
L<Moose> already installed. (It's also on CPAN, btw.)
=head2 Perl libraries that use Moose
Perl classes that inherit from Moose will have tons of "meta methods" like
C<before>, C<after>, C<has>, and C<meta>, which are not very interesting
while plotting the class diagram. So it's common practice to specify
the C<--without-inherited-methods> option like this:
$ umlclass.pl --without-inherited-methods -o uml.png -r lib
If you also add C<--moose-roles>, extra edges will appear in the
graph, in an alternate color, representing the relationships between roles
and their consumers.
=head2 Draw Alias's PPI
$ umlclass.pl -M PPI -o samples/ppi_small.png -p "^PPI::" -s 10x10
=begin html
<img src="http://perlcabal.org/agent/images/ppi_small.png">
=end html
(See also L<http://perlcabal.org/agent/images/ppi_small.png>.)
Or the full-size version:
$ umlclass.pl -M PPI -o samples/ppi_big.png -p "^PPI::"
(See L<http://perlcabal.org/agent/images/ppi_big.png>.)
BTW, L<PPI> is a prerequisite of this module.
=head2 Draw FAST.pm from UML::Class::Simple's Test Suite
$ umlclass.pl -M FAST -o samples/fast.png -s 5x10 -r t/FAST/lib
This is an example of drawing classes contained in Perl source files.
=head2 Draw Modules of Your Own
Suppose that you're a CPAN author too and want to produce a class diagram for I<all>
the classes contained in your lib/ directory. The following command can do all the
hard work for you:
$ umlclass.pl -o mylib.png -r lib
or just plot the packages in the specified .pm files:
$ umlclass.pl -o a.png lib/foo.pm lib/bar/baz.pm
or even specify a pattern (in perl regex) to filter out the packages you want to draw:
$ umlclass.pl -o a.png -p "^Foo::" lib/foo.pm
Quite handy, isn't it? ;-)
=head1 IMPORTANT ISSUES
Never feed plain module names to F<umlclass.pl>, for intance,
$ umlclass.pl Scalar::Defer # DO NOT DO THIS!
will lead you to the following error message:
error: input file Scalar::Defer not found.
Use C<-M> and C<-p> options to achieve your goals:
$ umlclass.pl -M Scalar::Defer -p "Scalar::Defer"
In this example, I must warn you that you may miss the
packages which belong to Scalar::Defer but don't have "Scalar::Defer"
in their names. I'm sorry for that. F<umlclass.pl> is not I<that>
smart.
The safest ways to do this are
=over
=item 1.
Don't specify the C<-p regex> option and generate a large image which shows
every classes including CORE modules, figure out the appropriate class
name pattern yourself, and rerun C<umlclass.pl> with the right regex pattern.
=item 2.
Grab the Scalar::Defer's tarball, and do something like this:
$ umlclass.pl -r Scalar-Defer-0.07/lib
=back
It's worth mentioning that when .pl or .pm files are passing as the command line
arguments, I<only> the classes I<defined> in these files will be drawn. This is
a feature. :)
For F<.pm> files on your disk, simply pass them as the command line
arguments. For instance:
$ umlclass.pl -o bar.gif lib/Bar.pm lib/*/*.pm
or tell F<umlclass.pl> to iterate through the directories for you:
$ umlclass.pl -o blah.png -r ./lib
=head1 OPTIONS
=over
=item --color color
=item -c color
Sets the node color. Defaults to C<#f1e1f4>.
You can either specify RGB values like C<#rrggbb> in hex form, or
color names like "C<grey>" and "C<red>".
=item --dot path
Tell it where the graphviz "dot" program is
=item --exclude path
=item -E path
excludes modules that were installed to C<path> from
the drawing. multiple C<-E> options are supported.
=item --help
=item -h
Shows the help message.
=item --include path
=item -I path
Draws I<only> the classes that were installed to
C<path> in the drawing. multiple C<-I> options are supported.
=item -M module
Preloads the module which contains the classes you want to depict. For example,
$ umlclass.pl -M PPI -o ppi.png -p "^PPI::"
Multiple C<-M> options are accepted. For instance:
$ umlclass.pl -M Foo -M Bar::Baz -p "Class::"
=item --no-methods
Don't display method names in the output.
=item --no-inheritance
Don't show the inheritance relationships in the output. Not terribly useful
unless you are using C<Moose> and asking for C<--moose-roles>.
=item --out outfile
=item -o outfile
Specifies the output file name. Note that the file extension will be honored.
If you specify "C<-o foo.png>", a PNG image named F<foo.png> will be generated,
and if you specify "C<-o foo.dot>", the dot source file named F<foo.dot> will
be obtained.
If you specify "C<-o foo.xmi>", the XMI model file will be generated.
Likewise, "C<-o foo.yml>" will lead to a YAML file holding the whole
internal DOM data.
A typical usage is as follows:
$ umlclass.pl -o foo.yml lib/Foo.pm
# ...edit the foo.yml so as to adjust the class info
# feed the updated foo.dot back
$ umlclass.pl -o foo.dot foo.yml
# ...edit the foo.dot so as to adjust the graphviz dot source
# now feed the updated foo.dot back
$ umlclass.pl -o foo.png foo.dot
You see, F<umlclass.pl> allows you to control the behaviors at several different
levels. I really like this freedom, since tools can't always do exactly what I want.
If no C<-o> option was specified, F<a.png> will be assumed.
=item --pattern regex
=item -p regex
Specifies the pattern (perl regex) used to filter out the class names to be drawn.
=item --public-only
=item -P
Shows public methods only.
=item --recursive
=item -r
Processes subdirectories of input directories recursively.
=item --moose-roles
If a package appears to be a L<Moose::Role>, determine which other
packages consume that role, and add that information to the graph
in a different color from the inheritance hierarchy. Depending on
the particular input classes and your personal artistic tastes,
this may substantially alter the usefulness and/or cleanliness of
the resulting diagram. For large package hierarchies, it is
recommended to combine this with B<--no-inheritance>.
=item --size
=item -s <w>x<h>
Specifies the width and height of the resulting image. For example:
-s 3.6x7
--size 5x6
where the unit is inches instead of pixels.
=item --without-inherited-methods
Do not show methods from parent classes.
All inherited and imported methods will be excluded. Note that if a method
is overridden in the current subclass, it will still be included even if
it appears in one of its ancestors.
=back
=head1 TODO
=over
=item *
If the user passes plain module names like "Foo::Bar", then its (and only its)
ancestors and subclasses will be drawn. (This is suggested by Christopher Malon.)
=back
=head1 AUTHORS
Agent Zhang E<lt>agentzh@gmail.comE<gt>,
Maxim Zenin E<lt>max@foggy.ruE<gt>
=head1 COPYRIGHT
Copyright 2006 by Agent Zhang. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as perl itself.
=head1 SEE ALSO
L<UML::Class::Simple>.