#!/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

gen_lc_img.pl (ver. 1.00) - generate lifecycle images from base databa
+se

=head1 SYNOPSIS

 gen_lc_img.pl -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
[download]