Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Re: graphviz, perl and sql2dot ?

by particle (Vicar)
on Oct 13, 2003 at 22:45 UTC ( #298969=note: print w/replies, xml ) Need Help??

in reply to graphviz, perl and sql2dot ?

while not a general case, i wrote a small script last friday to generate images directly from an oracle database. i was going to post a link to the code, but instead i'll stick it below.

it's a bit overkill on the argument parsing, but that's because i scavenged another script to write this, and never bothered to clean up the extra cruft. it should give you some idea how to write the sql, feed the results to GraphViz, and generate output.

#!/usr/bin/perl use 5.008; use strict; use warnings; $|++; use DBI; use GraphViz; use Getopt::Long qw(GetOptions); use Pod::Usage qw(pod2usage); use File::Spec::Functions qw(catdir catfile); use Config::Auto qw(); our $VERSION= 1.00; ## magically read the config file my $cfg= Config::Auto::parse(); ## default critical values if not set in config or file not found CONFIG: { $cfg->{dsn} ||= 'my_odbc_dsn'; $cfg->{basedb} ||= 'my_base_db'; $cfg->{imagetype} ||= 'gif'; } ## process command line options GetOptions( 'dsn=s' => \$cfg->{dsn}, 'basedb=s' => \$cfg->{basedb}, 'imagetype=s' => \$cfg->{imagetype}, 'verbose|v' => \$cfg->{verbose}, 'quiet|q' => sub{ $cfg->{verbose}= 0 }, 'help|h' => \my $help, 'man|m' => \my $man, ) or pod2usage(-verbose => 0); $help and pod2usage(-verbose => 1); $man and pod2usage(-verbose => 2); 1 == @ARGV or pod2usage(-verbose => 0); my( $imgdir )= @ARGV; -w $imgdir or die qq{ERROR: image directory ($imgdir) is not writable: $!}; ## connect to database my $dbh= DBI->connect( 'dbi:ODBC:' . $cfg->{dsn}, ( $cfg->{basedb} ) x 2, { RaiseError => 1 }, ) or die DBI->errstr; ## get list of lifecycle ids my %lifecycle_ids; $lifecycle_ids{ $$_[0] }= $$_[1] for @{ $dbh->selectall_arrayref(<<SQL) }; SELECT DISTINCT pcms_life_cycles.lifecycle_id, lifecycle_desc.description FROM pcms_life_cycles, lifecycle_desc WHERE pcms_life_cycles.lifecycle_id = lifecycle_desc.lifecycle_id SQL ## get lifecycle info my $sth= $dbh->prepare(<<SQL); SELECT doc_status, next_doc_status, role, norm_lc FROM pcms_life_cycles WHERE pcms_life_cycles.lifecycle_id = ? SQL my %lifecycles= map { $sth->execute( $_ ); $_ => $sth->fetchall_arrayref; } keys %lifecycle_ids; ## create lifecycle images for( keys %lifecycles ) { $cfg->{verbose} and print qq{creating image for $_... }; my $g= GraphViz->new( graph => { label => $lifecycle_ids{$_}, labelloc => 'top', directed => 'true', rankdir => '0', layout => 'dot', no_overlap => 'true', center => 'true', ratio => 'auto', nodesep => 0.5, ranksep => 0.5, }, node => { shape => 'box', style => 'filled', fillcolor => '#eeeeee', fontname => 'Tahoma', fontsize => 8, fontcolor => '#003399', width => 1.5, height => 0.5, }, edge => { fontname => 'Verdana', fontsize => 6, labelfloat => 'false', constraint => 'true', }, ); ## create states my %states; for( @{ $lifecycles{$_} } ) { $states{$$_[0]}= undef; $g->add_node( $$_[0], group => 'Y' eq $$_[3] ? 'normal' : '', ) unless exists $states{$$_[0]}; } ## create transitions for( @{ $lifecycles{$_} } ) { $g->add_edge( $$_[0] => $$_[1], label => $$_[2], color => 'Y' eq $$_[3] ? '#009933' : '#993300', weight => 'Y' eq $$_[3] ? 10 : 0, rank => 'Y' eq $$_[3] ? '' : 2, ); } ## create image file my $img= catfile( $imgdir, $_ . '.' . $cfg->{imagetype}, ); unless( open local(*IMG) => '>', $img ) { $cfg->{verbose} and print qq{error.\n}; warn qq{ERROR: can't create $img: $!$/continuing...}; next; } binmode IMG; $g->as_gif( \*IMG ); close IMG; $cfg->{verbose} and print qq{done.\n}; } =pod =head1 NAME (ver. 1.00) - generate lifecycle images from base databa +se =head1 SYNOPSIS -dsn *odbc dsn* -basedb *base database* [ -verbose ] [ -quiet ] [ -imagetype *image type* ] *directory* Options: -dsn *odbc dsn* -basedb *base database* -imagetype *image type* - currently supports 'gif' -verbose display more output -quiet display less output -help, -h brief help message -man, -m full documentation =head1 ARGUMENTS =over 4 =item B<*directory*> Specify the directory in which to create the lifecycle images. The script will fail with an error if this directory does not exist or is not writable. =back =head1 OPTIONS =over 4 =item B<-dsn *odbc dsn*> The ODBC Data Service Name (DSN) used to connect to the database. =item B<-basedb *base database*> The Dimensions Base Database used to generate images. =item B<-imagetype *image type*> The type of images to generate. Currently, this can be 'gif' (because i'm lazy.) This option is not required on the command-line, as the script searches for a value in the configuration file. If the value cannot be found, or the configuration file does not exist, the script defaults to the location specified in the script body. =item B<-verbose> Display verbose information. =item B<-quiet> Do not display any information (except errors and warnings.) This is the default behavior. =head1 CONFIG This script configures itself magically. If command-line options are passed, those values are used. If no options are passed, the magical L<Config::Auto> module is used to determine the script configuration. If a config file is not found, the script sets the most crucial variables to values defined in a CONFIG block inside the script. The config file packaged with this script contains three variables: ## odbc dsn name dsn=ddim ## base database name basedb=ets_devtest ## output image type imagetype=gif I think that's pretty self-explanitory, so I'll leave it at that. =head1 DESCRIPTION This script is designed to generate lifecycle images from information contained in the Dimensions database. Dimensions has many object types (items, change documents, baselines, +etc.) Further complicating things, each of these object types are used to de +fine multiple objects. For example, of the change document object type, my +client has defined twelve varieties, handling various aspects of the software + development lifecycle. Each object has its own lifecycle -- a set of connected states and tra +nsitions between those states. As a Dimensions end user, it's easy to get confu +sed as to what options you have at any given state in the lifecycle of a p +articular object. Thankfully, Dimensions has a feature that allows an administra +tor to supply images to describe each object's lifecycle. This way, a user ca +n get a visual representation of state and transition information for the life +cycle of that object. Currently, my client develops these pictures by manually extracting th +em from the system requirements document. This presents several real problems: the + manual process is cumbersome and error prone, the document may not match the +actual implementation, and it's so 1995. I have, using Perl, developed a script that will extract state and tra +nsition information from the Dimensions database, and generate images portrayi +ng that information in an ordered fashion (a directed graph.) Although the diagrams aren't centerfold quality, I believe they are ad +equate to portray lifecycle information to a Dimensions user. Additionally, t +hese images can be regenerated on a scheduled basis, so they will be closer + to a true reflection of the system. Additionally, these diagrams offer a wa +y to validate a requirements document, as they portray the actual implement +ation. =head1 COPYRIGHT Copyright (C) 2003 Ars ex Machina. All Rights Reserved. This module is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. =head1 SEE ALSO L<DBI>, L<GraphViz>, L<Config::Auto> =head1 AUTHOR particle <particle at cpan dot org> =cut

~Particle *accelerates*

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://298969]
[Eily]: I still don't understand how the Turkish AA fit into the German+Czech joke though :P
[LanX]: new Firefox + cb sidebar do random auto expand on submit
[LanX]: probably need to start pm discussion
[LanX]: they have a constitutional referendum in turkey, kind of "do you want a dictator" and everybody opting no gets problems ...
[Corion]: LanX: Random Auto Expand?

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (9)
As of 2017-03-27 12:11 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (319 votes). Check out past polls.