use strict; use GraphViz; use XML::Twig; # mkg($xml, $output_file_name) mkg("@{[]}", "orgchart"); sub mkg { my ($xml, $file) = @_; my $root = XML::Twig->new()->parse($xml)->root; my $g = GraphViz->new(); render($g, $root); $g->as_jpeg("$file.jpg"); } sub render { my ($g, $root) = @_; my $super = mkname($root); $g->add_node($super); foreach my $child ($root->children) { my $subord = mkname($child); $g->add_edge($super => $subord, dir => 'back'); render($g, $child); } } sub mkname { $_[0]->att('title') . " (" . $_[0]->att('name') . ")"; } __DATA__ #### use strict; use warnings; use Win32::OLE; $Win32::OLE::Warn = 3; my $path = "c:\\files\\visio\\"; my $file = "test.vsd"; my $Visio = Win32::OLE->new('Visio.Application', 'Quit'); my $VDocs = $Visio->Documents; my $VDoc = $VDocs->Open("$path$file"); my $VPage = $VDoc->Pages->Item(1); my $VShapes = $VPage->Shapes; my $VShape = $VShapes->Item(1); $VShape->{Text} = "New Name"; print $VShape->{Text}; $VDoc->SaveAs($path."test2.vsd"); #### use strict; use warnings; use GraphViz; my $g = GraphViz->new(node => {fontsize => 10}, edge => {fontsize => 9}, rankdir => 'LR'); $g->add_node('email', label => "Email App:\nperiodic DB query\nto send emails", shape => 'box'); $g->add_node('report', label => "periodic financial\nstatement"); $g->add_node('cond', label => "amount\nowed", shape => 'Mdiamond'); $g->add_node('msgS', label => "very frightening\nmessage"); $g->add_node('msgM', label => "extremely frightening\nmessage with\nrandom death threat"); $g->add_node('msgL', label => "very frightening\nmessage without\ndeath threat"); $g->add_node('thankC', label => "thank you\nfor your business"); $g->add_node('thankD', label => "thank you\nfor your payment"); $g->add_edge('email' => 'report', label => 'creditor/collector'); $g->add_edge('email' => 'cond', label => 'debtor'); $g->add_edge('cond' => 'msgS', label => 'small'); $g->add_edge('cond' => 'msgM', label => 'medium'); $g->add_edge('cond' => 'msgL', label => 'large'); $g->add_edge('email' => 'thankC', label => 'creditor/collector'); $g->add_edge('email' => 'thankD', label => 'debtor'); $g->as_jpeg("email01.jpg"); #### $g = GraphViz->new(node => {fontsize => 10}, edge => {fontsize => 9}, rankdir => 'LR'); $g->add_node('email', label => "Email App:\nperiodic DB query\nto send emails", shape => 'box'); $g->add_node('report', label => "periodic financial\nstatement", cluster => 'report'); $g->add_node('cond', label => "amount\nowed", shape => 'Mdiamond'); $g->add_node('msgS', label => "very frightening\nmessage", cluster => 'report'); $g->add_node('msgM', label => "extremely frightening\nmessage with\nrandom death threat", cluster => 'report'); $g->add_node('msgL', label => "very frightening\nmessage without\ndeath threat", cluster => 'report'); $g->add_node('thankC', label => "thank you\nfor your business", cluster => 'thank'); $g->add_node('thankD', label => "thank you\nfor your payment", cluster => 'thank'); $g->add_edge('email' => 'report', label => 'creditor/collector'); $g->add_edge('email' => 'cond', label => 'debtor'); $g->add_edge('cond' => 'msgS', label => 'small'); $g->add_edge('cond' => 'msgM', label => 'medium'); $g->add_edge('cond' => 'msgL', label => 'large'); $g->add_edge('email' => 'thankC', label => 'creditor/collector'); $g->add_edge('email' => 'thankD', label => 'debtor'); $g->as_jpeg("email02.jpg"); #### my @color = (color => 'lightgray', fontcolor => 'lightgray'); $g = GraphViz->new(node => {shape => 'box', fontsize => 10}, edge => {fontsize => 9}, rankdir => 'LR'); $g->add_node('email', label => "Email App:\nperiodic DB query\nto send emails"); $g->add_node('report', shape => 'ellipse'); $g->add_node('thank', label => "thanks you\nnote", shape => 'ellipse'); $g->add_node('report XSL', @color); $g->add_node('thank XSL', @color); $g->add_node('XML data', @color); $g->add_edge('email' => 'report', label => "all"); $g->add_edge('email' => 'thank', label => "all"); $g->add_edge('report' => 'report XSL', label => 'use', @color); $g->add_edge('thank' => 'thank XSL', label => 'use', @color); $g->add_edge('report' => 'XML data', label => 'use', @color); $g->add_edge('thank' => 'XML data', label => 'use', @color); $g->as_jpeg("email03.jpg"); #### DROP TABLE IF EXISTS org; CREATE TABLE org ( id int NOT NULL, name varchar(255) NOT NULL, PRIMARY KEY (id), UNIQUE KEY id (id) ) TYPE=InnoDB; DROP TABLE IF EXISTS employee; CREATE TABLE employee ( id int NOT NULL, name varchar(255) NOT NULL, PRIMARY KEY (id), UNIQUE KEY id (id) ) TYPE=InnoDB; DROP TABLE IF EXISTS orgstruct; CREATE TABLE orgstruct ( org_id int NOT NULL, employee_id int NOT NULL, subord_id int NOT NULL, PRIMARY KEY (org_id, employee_id, subord_id), INDEX (org_id), INDEX (employee_id), INDEX (subord_id), FOREIGN KEY (org_id) REFERENCES org (id), FOREIGN KEY (employee_id) REFERENCES employee (id), FOREIGN KEY (subord_id) REFERENCES employee (id) ) TYPE=InnoDB; #### use strict; use warnings; use DBI; use GraphViz::DBI; my $dbh = DBI->connect("DBI:mysql:test", "user", "password"); GraphViz::DBI->new($dbh)->graph_tables->as_jpeg("dbi.jpg"); $dbh->disconnect; #### use strict; use GraphViz; use XML::Twig; # write $file.jpg and $file.html to files # mkg($xml, $output_file_name) my $file = "modules"; my $map = mkg("@{[]}", $file); my $html = < $map HTML open OUT, ">$file.html"; print OUT $html; close OUT; sub mkg { my ($xml, $file) = @_; my $root = XML::Twig->new()->parse($xml)->root; my $g = GraphViz->new(); render($g, $root); $g->as_jpeg("$file.jpg"); return $g->as_cmap; } sub render { my ($g, $root) = @_; $g->add_node($root->att('name'), URL => $root->att('src'), shape => 'record'); foreach my $child ($root->children) { $g->add_edge($root->att('name') => $child->att('name')); render($g, $child); } } __DATA__ #### use strict; use GraphViz; use XML::Twig; use List::Util qw/ max /; my @profile; for () { chomp; push @profile, [split /\s+/]; } push @profile, [undef, 'end']; my $max = max( map {$_->[0]} @profile ); my $g = GraphViz->new(); for my $i (0..($#profile-1)) { my $w1 = ($profile[$i][0])/$max ; my $w2 = 1-$w1/2; my $color = "$w1,$w2,$w2"; $g->add_node($profile[$i][1], fontcolor => $color, color => $color); $g->add_node($profile[$i+1][1]); $g->add_edge($profile[$i][1] => $profile[$i+1][1], label => $profile[$i][0], color => $color, fontcolor => $color); } $g->as_jpeg("profile.jpg"); # millisec sub __DATA__ 1 fetchXML 2 preprocessXML 5 generateReport 1 randomThreat 6 generateReport 2 sendemail #### # Original code: "Prettified Perl Inheritance" by Kageneko use strict; use warnings; no strict 'refs'; use GraphViz; my $module = 'Net::FTP'; my $output_jpg_file_name = 'isa'; my %already_loaded = (); # write $output_jpg_file_name.jpg to file my $g = GraphViz->new; ScanModule($g, undef, $module, 0); $g->as_jpeg("$output_jpg_file_name.jpg"); sub ScanModule { my $g = shift; my $parent = shift; my $module = shift; my $depth = shift; my @total = @_; my $loaded = 0; my $label; $loaded = 1 if (exists $already_loaded{$module}); eval "use $module" if (!defined $parent); $g->add_edge($parent => $module) if $depth > 0; $label = $module; unless ($loaded) { my $version = $module->VERSION(); $label .= " (v$version)" if $version; $g->add_node($module, label => $label); my $isa = "${module}::ISA"; my $count = 1; my $total = @$isa; foreach (@$isa) { ScanModule($g, $module, $_, $depth + 1, @total, $count, $total); $count++; } $already_loaded{$module} = $parent; } }