RE: [CDBI] ERD's

#!/usr/bin/perl -w

use strict;
use File::Temp qw/tempfile/;
use Getopt::Long;

# defaults
my %opts = ( outfile => '/tmp/db_diagram.ps',
	     help => 0,
	     keep => 0,
	     a3ps => 1,
	   );

sub usage {
  die "
Usage: $0 --module_base My::Namespace --path path_to_pm_files --dsn dbi_dsn_string [options]
Options:
  --path dir          Path in which your pm files live for this module
                      base. May be given more than once.
  --outfile filename  Output file; type is determined by extension.
                      Default is $opts{outfile}. See Graphviz for
                      supported output formats.
  --[no]keep          Whether to keep temporary script file. Default is
                      to clean up after ourselves.
  --dsn string        DBI dsn for connecting to your database
  --user string       DB connection username
  --pass string       DB connection password
  --[no]a3ps          Convert ps output to A3 (if outfile is a .ps file)
                      This requires the psnup command.
  --help              This help

";
}

GetOptions( \%opts,
	    'module_base|base|b=s',
	    'outfile=s',
	    'path=s@',
	    'dsn=s',
	    'user=s',
	    'pass=s',
	    'keep!',
	    'help|h+'
	  ) or usage();

usage() if $opts{help};
usage() unless $opts{module_base};
usage() unless $opts{dsn};

die "Output file [$opts{outfile}] already exists, not overwriting\n" if -e $opts{outfile};

# we need a non-conflicting namespace so just get the last part of the
# module namespace. This may cause issues if you've got a
# module_basname of just one level - untested.
($opts{namespace} = $opts{module_base}) =~ s/^.*:://;


# Quick hack to find all module files
my @files;
{
  my %f;
  foreach my $dir (@{$opts{path}}) {
    $f{$_}++ foreach glob("$dir/*.pm");
  }
  @files = keys %f;
}

my ($format) = ( $opts{outfile} =~ m/\.([^\.]+)$/ );
my $output_func = "as_$format";

# generate stringified args to Loader
my $loader_args = join( ",\n",
			map  { qq{$_ => '$opts{$_}'} }
			grep { defined $opts{$_}     }
			qw(namespace dsn user pass) );

#my ($fh,$filename) = tempfile( 'bit_gen_diagram_XXXXX', DIR => '/tmp', UNLINK => 1 );
# do our own unlinking as we can't exec a file while its still being
# written to ...
my ($fh,$filename) = tempfile( 'db_gen_diagram_XXXXX', DIR => '/tmp' );
END { unlink $filename if ($filename && !$opts{keep}) };

chmod 0755, $filename;
print $fh '#!/usr/bin/perl -w

use strict;
use GraphViz;
use GraphViz::DBI;
use Class::DBI::Loader::GraphViz;

my $loader = Class::DBI::Loader->new(
' . $loader_args . '
);

';

# now scan all .pm files in our namespace and import all has_a
# relationships. __PACKAGE__ will need to be translated to be an
# absolute during this process.
#
# We also need to convert any all-caps module name in our namespace to
# ucfirst()
foreach my $f (@files) {
  my ($name) = ($f =~ m,/([^/]+).pm$,);
  if ( open( IN, "<$f" ) ) {
    print $fh $_ foreach
      map { s/__PACKAGE__/$opts{namespace}::$name/;
	    s/$opts{module_base}/$opts{namespace}/g;
	    s/(?<=$opts{namespace}::)([A-Z]+)/ucfirst(lc($1))/eg;
	    $_;
	  } grep( /^\s*(?:__PACKAGE__|$opts{module_base})->has_a.*$opts{module_base}/, <IN>);
    close IN;
  } else {
    warn "Couldn't process file [$f]: $!\n";
  }
}

print $fh '

my GraphViz $g = $loader->graph_tables;
$g->{RANK_DIR} = 1;
if (open(OUT,">'.$opts{outfile}.'")) {
  print OUT $g->'.$output_func.';
  close OUT;
}

exit;
';
close $fh;

system($filename);

if ($format =~ m/ps$/ && $opts{a3ps}) {
  # now do all the resizing tricks to get this into A3 landscape
  # First, get the boundingbox
  open(IN,"<$opts{outfile}") or die "Cannot open $opts{outfile}: $!";
  my ($width, $height);
  while (<IN>) {
    if (m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/) {
      # cheat and don't take the offsets into account. ie don't do X2-X1, just use X2
      $width = $3;
      $height = $4;
      last;
    }
  }
  close IN;
  die "Couldn't find width and height of image file!\n" unless $width && $height;
  my $newfile = $opts{outfile};
  $newfile =~ s/\.(\w+)$/_a3.$1/;
  my $cmd = "/usr/bin/psnup -l -W $width -H $height -p a3 $opts{outfile} $newfile";
  print "Running $cmd\n";
  system($cmd);
}

exit;