[dbsrgits/SQL-Translator.git] / bin / auto-dia.pl

#!/usr/bin/perl

# $Id: auto-dia.pl,v 1.3 2003-02-15 23:38:35 kycl4rk Exp $

=head1 NAME 

auto-dia.pl - Automatically create a diagram from a database schema

=head1 SYNOPSIS

  ./auto-dia.pl -d|--db=db_parser [options] schema.sql

  Options:

    -o|--output     Output file name (default STDOUT)
    -i|--image      Output image type (default PNG)
    -t|--title      Title to give schema
    -c|--cols       Number of columns
    -n|--no-lines   Don't draw lines
    -s|--skip       Fields to skip in natural joins
    --join-pk-only  Perform natural joins from primary keys only

=head1 DESCRIPTION

This script will create a picture of your schema.  Only the database
driver argument (for SQL::Translator) is required.  If no output file
name is given, then image will be printed to STDOUT, so you should
redirect the output into a file.

=cut

use strict;
use Getopt::Long;
use GD;
use Pod::Usage;
use SQL::Translator;

my $VERSION = (qw$Revision: 1.3 $)[-1];

#
# Get arguments.
#
my ( $out_file, $image_type, $db_driver, $title, $no_columns, 
    $no_lines, $skip_fields, $join_pk_only );
GetOptions(
    'd|db=s'         => \$db_driver,
    'o|output:s'     => \$out_file,
    'i|image:s'      => \$image_type,
    't|title:s'      => \$title,
    'c|columns:i'    => \$no_columns,
    'n|no-lines'     => \$no_lines,
    's|skip:s'       => \$skip_fields,
    '--join-pk-only' => \$join_pk_only,
) or die pod2usage;
my $file = shift @ARGV or pod2usage( -message => 'No input file' );

pod2usage( -message => "No db driver specified" ) unless $db_driver;
$image_type = $image_type ? lc $image_type : 'png';
$title    ||= $file;
my %skip    = map { $_, 1 } split ( /,/, $skip_fields );

#
# Parse file.
#
my $t    = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
my $data = $t->translate( $file ) or die $t->error;
use Data::Dumper;
#print Dumper( $data );
#exit;

#
# Layout the image.
#
my $font         = gdTinyFont;
my $no_tables    = scalar keys %$data;
$no_columns    ||= sprintf( "%.0f", sqrt( $no_tables ) + .5 );
my $no_per_col   = sprintf( "%.0f", $no_tables/$no_columns + .5 );

my @shapes;            
my ( $max_x, $max_y );           # the furthest x and y used
my $orig_y      = 40;            # used to reset y for each column
my ( $x, $y )   = (20, $orig_y); # where to start
my $cur_col     = 1;             # the current column
my $no_this_col = 0;             # number of tables in current column
my $this_col_x  = $x;            # current column's x
my $gutter      = 30;            # distance b/w columns
my %registry;                    # for locations of fields
my %table_x;                     # for max x of each table
my $field_no;                    # counter to give distinct no. to each field

for my $table (
    map  { $_->[1] }
    sort { $a->[0] <=> $b->[0] }
    map  { [ $_->{'order'}, $_ ] }
    values %$data 
) {
    my $table_name = $table->{'table_name'};
    my $top        = $y;
    push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ];

    $y                   += $font->height + 2;
    my $below_table_name  = $y;
    $y                   += 2;
    my $this_max_x        = $this_col_x + ($font->width * length($table_name));

    my @fields = 
        map  { $_->[1] }
        sort { $a->[0] <=> $b->[0] }
        map  { [ $_->{'order'}, $_ ] }
        values %{ $table->{'fields'} };

    my %pk;
    for my $index ( @{ $table->{'indices'} || [] } ) {
        next unless $index->{'type'} eq 'primary_key';
        my @fields = @{ $index->{'fields'} || [] } or next;
        $pk{ $_ } = 1 for @fields;
    }

    my ( @fld_desc, $max_name );
    for my $f ( @fields ) {
        my $name  = $f->{'name'} or next;
        my $is_pk = $pk{ $name };
        $name   .= ' *' if $is_pk;

        my $size = @{ $f->{'size'} || [] } 
            ? '(' . join( ',', @{ $f->{'size'} } ) . ')'
            : '';
        my $desc = join( ' ', map { $_ || () } $f->{'data_type'}, $size );
        
        my $nlen  = length $name;
        $max_name = $nlen if $nlen > $max_name;
        push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk ];
    }

    $max_name += 4;
    for my $fld_desc ( @fld_desc ) {
        my ( $name, $desc, $orig_name, $is_pk ) = @$fld_desc;
        my $diff = $max_name - length $name;
        $name   .= ' ' x $diff;
        $desc    = $name . $desc;

        push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ];
        $y         += $font->height + 2;
        my $length  = $this_col_x + ( $font->width * length( $desc ) );
        $this_max_x = $length if $length > $this_max_x;

        unless ( $skip{ $orig_name } ) {
            my $y_link = $y - $font->height * .75;
            push @{ $registry{ $orig_name } }, {
                left     => [ $this_col_x - 2, $y_link ],
                right    => [ $length,         $y_link ],
                table    => $table_name,
                field_no => ++$field_no,
                is_pk    => $is_pk,
            };
        }
    }

    $this_max_x += 5;
    $table_x{ $table_name } = $this_max_x + 5;
    push @shapes, [ 'line', $this_col_x - 5, $below_table_name, 
        $this_max_x, $below_table_name, 'black' ];
    push @shapes, [ 
        'rectangle', $this_col_x - 5, $top - 5, $this_max_x, $y + 5, 'black'
    ];
    $max_x = $this_max_x if $this_max_x > $max_x;
    $y    += 25;
    
    if ( ++$no_this_col == $no_per_col ) { # if we've filled up this column
        $cur_col++;                        # up the column number
        $no_this_col = 0;                  # reset the number of tables
        $max_x      += $gutter;            # push the x over for next column
        $this_col_x  = $max_x;             # remember the max x for this column
        $max_y       = $y if $y > $max_y;  # note the max y
        $y           = $orig_y;            # reset the y for next column
    }
}

#
# Connect the lines.
#
my %horz_taken;
my %done;
unless ( $no_lines ) {
    for my $field_name ( keys %registry ) {
        my @positions = @{ $registry{ $field_name } || [] } or next;
        next if scalar @positions == 1;

        for my $i ( 0 .. $#positions ) {
            my $pos1        = $positions[ $i ];
            my ( $ax, $ay ) = @{ $pos1->{'left'}  };
            my ( $bx, $by ) = @{ $pos1->{'right'} };
            my $table1      = $pos1->{'table'};
            my $fno1        = $pos1->{'field_no'};
            my $is_pk       = $pos1->{'is_pk'};
            next if $join_pk_only and !$is_pk;

            for my $j ( 0 .. $#positions ) {
                my $pos2        = $positions[ $j ];
                my ( $cx, $cy ) = @{ $pos2->{'left'}  };
                my ( $dx, $dy ) = @{ $pos2->{'right'} };
                my $table2      = $pos2->{'table'};
                my $fno2        = $pos2->{'field_no'};
                next if $done{ $fno1 }{ $fno2 };
                next if $fno1 == $fno2;

                my @distances = ();
                push @distances, [
                    abs ( $ax - $cx ) + abs ( $ay - $cy ),
                    [ $ax, $ay, $cx, $cy ],
                    [ 'left', 'left' ]
                ];
                push @distances, [
                    abs ( $ax - $dx ) + abs ( $ay - $dy ),
                    [ $ax, $ay, $dx, $dy ],
                    [ 'left', 'right' ],
                ];
                push @distances, [
                    abs ( $bx - $cx ) + abs ( $by - $cy ),
                    [ $bx, $by, $cx, $cy ],
                    [ 'right', 'left' ],
                ];
                push @distances, [
                    abs ( $bx - $dx ) + abs ( $by - $dy ),
                    [ $bx, $by, $dx, $dy ],
                    [ 'right', 'right' ],
                ];
                @distances   = sort { $a->[0] <=> $b->[0] } @distances;
                my $shortest = $distances[0];
                my ( $x1, $y1, $x2, $y2 ) = @{ $shortest->[1] };
                my ( $side1, $side2     ) = @{ $shortest->[2] };
                my ( $start, $end );
                my $offset     = 9;
                my $col1_right = $table_x{ $table1 };
                my $col2_right = $table_x{ $table2 };

                my $diff = 0;
                if ( $x1 == $x2 ) {
                    while ( $horz_taken{ $x1 + $diff } ) {
                        $diff = $side1 eq 'left' ? $diff - 2 : $diff + 2; 
                    }
                    $horz_taken{ $x1 + $diff } = 1;
                }

                if ( $side1 eq 'left' ) {
                    $start = $x1 - $offset + $diff;
                }
                else {
                    $start = $col1_right + $diff;
                }

                if ( $side2 eq 'left' ) {
                    $end = $x2 - $offset + $diff;
                } 
                else {
                    $end = $col2_right + $diff;
                } 

                push @shapes, [ 'line', $x1,    $y1, $start, $y1, 'lightblue' ];
                push @shapes, [ 'line', $start, $y1, $end,   $y2, 'lightblue' ];
                push @shapes, [ 'line', $end,   $y2, $x2,    $y2, 'lightblue' ];
                $done{ $fno1 }{ $fno2 } = 1;
                $done{ $fno2 }{ $fno1 } = 1;
            }
        }
    }
}

#
# Add the title and signature.
#
my $large_font = gdLargeFont;
my $title_len  = $large_font->width * length $title;
push @shapes, [ 
    'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black' 
];

my $sig     = "auto-dia.pl $VERSION";
my $sig_len = $font->width * length $sig;
push @shapes, [ 
    'string', $font, $max_x - $sig_len, $max_y - $font->height - 4, 
    $sig, 'black'
];

#
# Render the image.
#
my $gd = GD::Image->new( $max_x + 10, $max_y );
unless ( $gd->can( $image_type ) ) {
    die "GD can't create images of type '$image_type'\n";
}
my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } (
    [ white     => [ 255, 255, 255 ] ],
    [ black     => [   0,   0,   0 ] ],
    [ lightblue => [ 173, 216, 230 ] ],
);
$gd->interlaced( 'true' );
$gd->fill( 0, 0, $colors{ 'white' } );
for my $shape ( @shapes ) {
    my $method = shift @$shape;
    my $color  = pop   @$shape;
    $gd->$method( @$shape, $colors{ $color } );
}

#
# Print the image.
#
if ( $out_file ) {
    open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
    print $fh $gd->$image_type;
    close $fh;
    print "Image written to '$out_file'.  Done.\n";
}
else {
    print $gd->$image_type;
}

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>

=cut
Commit	Line	Data
dd9550a4	1	#!/usr/bin/perl
dd9550a4	2
7256996b	3	# $Id: auto-dia.pl,v 1.3 2003-02-15 23:38:35 kycl4rk Exp $
dd9550a4	4
	5	=head1 NAME
	6
	7	auto-dia.pl - Automatically create a diagram from a database schema
	8
	9	=head1 SYNOPSIS
	10
	11	./auto-dia.pl -d\|--db=db_parser [options] schema.sql
	12
	13	Options:
	14
7256996b	15	-o\|--output Output file name (default STDOUT)
	16	-i\|--image Output image type (default PNG)
	17	-t\|--title Title to give schema
	18	-c\|--cols Number of columns
	19	-n\|--no-lines Don't draw lines
	20	-s\|--skip Fields to skip in natural joins
	21	--join-pk-only Perform natural joins from primary keys only
dd9550a4	22
	23	=head1 DESCRIPTION
	24
	25	This script will create a picture of your schema. Only the database
aa0a19b9	26	driver argument (for SQL::Translator) is required. If no output file
	27	name is given, then image will be printed to STDOUT, so you should
	28	redirect the output into a file.
dd9550a4	29
	30	=cut
	31
	32	use strict;
	33	use Getopt::Long;
	34	use GD;
	35	use Pod::Usage;
	36	use SQL::Translator;
	37
7256996b	38	my $VERSION = (qw$Revision: 1.3 $)[-1];
dd9550a4	39
aa0a19b9	40	#
	41	# Get arguments.
	42	#
	43	my ( $out_file, $image_type, $db_driver, $title, $no_columns,
7256996b	44	$no_lines, $skip_fields, $join_pk_only );
dd9550a4	45	GetOptions(
7256996b	46	'd\|db=s' => \$db_driver,
	47	'o\|output:s' => \$out_file,
	48	'i\|image:s' => \$image_type,
	49	't\|title:s' => \$title,
	50	'c\|columns:i' => \$no_columns,
	51	'n\|no-lines' => \$no_lines,
	52	's\|skip:s' => \$skip_fields,
	53	'--join-pk-only' => \$join_pk_only,
dd9550a4	54	) or die pod2usage;
	55	my $file = shift @ARGV or pod2usage( -message => 'No input file' );
	56
	57	pod2usage( -message => "No db driver specified" ) unless $db_driver;
	58	$image_type = $image_type ? lc $image_type : 'png';
	59	$title \|\|= $file;
aa0a19b9	60	my %skip = map { $_, 1 } split ( /,/, $skip_fields );
dd9550a4	61
aa0a19b9	62	#
	63	# Parse file.
	64	#
dd9550a4	65	my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
dd9550a4	66	my $data = $t->translate( $file ) or die $t->error;
7256996b	67	use Data::Dumper;
	68	#print Dumper( $data );
	69	#exit;
dd9550a4	70
aa0a19b9	71	#
	72	# Layout the image.
	73	#
	74	my $font = gdTinyFont;
dd9550a4	75	my $no_tables = scalar keys %$data;
	76	$no_columns \|\|= sprintf( "%.0f", sqrt( $no_tables ) + .5 );
	77	my $no_per_col = sprintf( "%.0f", $no_tables/$no_columns + .5 );
dd9550a4	78
7256996b	79	my @shapes;
	80	my ( $max_x, $max_y ); # the furthest x and y used
	81	my $orig_y = 40; # used to reset y for each column
	82	my ( $x, $y ) = (20, $orig_y); # where to start
	83	my $cur_col = 1; # the current column
	84	my $no_this_col = 0; # number of tables in current column
	85	my $this_col_x = $x; # current column's x
	86	my $gutter = 30; # distance b/w columns
	87	my %registry; # for locations of fields
	88	my %table_x; # for max x of each table
	89	my $field_no; # counter to give distinct no. to each field
dd9550a4	90
	91	for my $table (
	92	map { $_->[1] }
	93	sort { $a->[0] <=> $b->[0] }
	94	map { [ $_->{'order'}, $_ ] }
	95	values %$data
	96	) {
	97	my $table_name = $table->{'table_name'};
	98	my $top = $y;
aa0a19b9	99	push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ];
dd9550a4	100
	101	$y += $font->height + 2;
	102	my $below_table_name = $y;
	103	$y += 2;
	104	my $this_max_x = $this_col_x + ($font->width * length($table_name));
	105
	106	my @fields =
	107	map { $_->[1] }
	108	sort { $a->[0] <=> $b->[0] }
	109	map { [ $_->{'order'}, $_ ] }
	110	values %{ $table->{'fields'} };
	111
7256996b	112	my %pk;
dd9550a4	113	for my $index ( @{ $table->{'indices'} \|\| [] } ) {
	114	next unless $index->{'type'} eq 'primary_key';
	115	my @fields = @{ $index->{'fields'} \|\| [] } or next;
7256996b	116	$pk{ $_ } = 1 for @fields;
dd9550a4	117	}
	118
	119	my ( @fld_desc, $max_name );
	120	for my $f ( @fields ) {
7256996b	121	my $name = $f->{'name'} or next;
	122	my $is_pk = $pk{ $name };
	123	$name .= ' *' if $is_pk;
dd9550a4	124
	125	my $size = @{ $f->{'size'} \|\| [] }
	126	? '(' . join( ',', @{ $f->{'size'} } ) . ')'
	127	: '';
	128	my $desc = join( ' ', map { $_ \|\| () } $f->{'data_type'}, $size );
	129
	130	my $nlen = length $name;
	131	$max_name = $nlen if $nlen > $max_name;
7256996b	132	push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk ];
dd9550a4	133	}
	134
	135	$max_name += 4;
	136	for my $fld_desc ( @fld_desc ) {
7256996b	137	my ( $name, $desc, $orig_name, $is_pk ) = @$fld_desc;
dd9550a4	138	my $diff = $max_name - length $name;
	139	$name .= ' ' x $diff;
	140	$desc = $name . $desc;
	141
aa0a19b9	142	push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ];
dd9550a4	143	$y += $font->height + 2;
	144	my $length = $this_col_x + ( $font->width * length( $desc ) );
	145	$this_max_x = $length if $length > $this_max_x;
aa0a19b9	146
	147	unless ( $skip{ $orig_name } ) {
	148	my $y_link = $y - $font->height * .75;
	149	push @{ $registry{ $orig_name } }, {
	150	left => [ $this_col_x - 2, $y_link ],
	151	right => [ $length, $y_link ],
	152	table => $table_name,
	153	field_no => ++$field_no,
7256996b	154	is_pk => $is_pk,
aa0a19b9	155	};
aa0a19b9	156	}
dd9550a4	157	}
	158
	159	$this_max_x += 5;
aa0a19b9	160	$table_x{ $table_name } = $this_max_x + 5;
dd9550a4	161	push @shapes, [ 'line', $this_col_x - 5, $below_table_name,
aa0a19b9	162	$this_max_x, $below_table_name, 'black' ];
dd9550a4	163	push @shapes, [
aa0a19b9	164	'rectangle', $this_col_x - 5, $top - 5, $this_max_x, $y + 5, 'black'
dd9550a4	165	];
	166	$max_x = $this_max_x if $this_max_x > $max_x;
	167	$y += 25;
	168
7256996b	169	if ( ++$no_this_col == $no_per_col ) { # if we've filled up this column
	170	$cur_col++; # up the column number
	171	$no_this_col = 0; # reset the number of tables
	172	$max_x += $gutter; # push the x over for next column
	173	$this_col_x = $max_x; # remember the max x for this column
	174	$max_y = $y if $y > $max_y; # note the max y
	175	$y = $orig_y; # reset the y for next column
dd9550a4	176	}
	177	}
	178
	179	#
aa0a19b9	180	# Connect the lines.
	181	#
	182	my %horz_taken;
	183	my %done;
	184	unless ( $no_lines ) {
	185	for my $field_name ( keys %registry ) {
	186	my @positions = @{ $registry{ $field_name } \|\| [] } or next;
	187	next if scalar @positions == 1;
	188
	189	for my $i ( 0 .. $#positions ) {
	190	my $pos1 = $positions[ $i ];
	191	my ( $ax, $ay ) = @{ $pos1->{'left'} };
	192	my ( $bx, $by ) = @{ $pos1->{'right'} };
	193	my $table1 = $pos1->{'table'};
	194	my $fno1 = $pos1->{'field_no'};
7256996b	195	my $is_pk = $pos1->{'is_pk'};
7256996b	196	next if $join_pk_only and !$is_pk;
aa0a19b9	197
7256996b	198	for my $j ( 0 .. $#positions ) {
aa0a19b9	199	my $pos2 = $positions[ $j ];
	200	my ( $cx, $cy ) = @{ $pos2->{'left'} };
	201	my ( $dx, $dy ) = @{ $pos2->{'right'} };
	202	my $table2 = $pos2->{'table'};
	203	my $fno2 = $pos2->{'field_no'};
	204	next if $done{ $fno1 }{ $fno2 };
7256996b	205	next if $fno1 == $fno2;
aa0a19b9	206
	207	my @distances = ();
	208	push @distances, [
	209	abs ( $ax - $cx ) + abs ( $ay - $cy ),
	210	[ $ax, $ay, $cx, $cy ],
	211	[ 'left', 'left' ]
	212	];
	213	push @distances, [
	214	abs ( $ax - $dx ) + abs ( $ay - $dy ),
	215	[ $ax, $ay, $dx, $dy ],
	216	[ 'left', 'right' ],
	217	];
	218	push @distances, [
	219	abs ( $bx - $cx ) + abs ( $by - $cy ),
	220	[ $bx, $by, $cx, $cy ],
	221	[ 'right', 'left' ],
	222	];
	223	push @distances, [
	224	abs ( $bx - $dx ) + abs ( $by - $dy ),
	225	[ $bx, $by, $dx, $dy ],
	226	[ 'right', 'right' ],
	227	];
	228	@distances = sort { $a->[0] <=> $b->[0] } @distances;
	229	my $shortest = $distances[0];
	230	my ( $x1, $y1, $x2, $y2 ) = @{ $shortest->[1] };
	231	my ( $side1, $side2 ) = @{ $shortest->[2] };
	232	my ( $start, $end );
7256996b	233	my $offset = 9;
aa0a19b9	234	my $col1_right = $table_x{ $table1 };
	235	my $col2_right = $table_x{ $table2 };
	236
	237	my $diff = 0;
	238	if ( $x1 == $x2 ) {
	239	while ( $horz_taken{ $x1 + $diff } ) {
	240	$diff = $side1 eq 'left' ? $diff - 2 : $diff + 2;
	241	}
	242	$horz_taken{ $x1 + $diff } = 1;
	243	}
	244
	245	if ( $side1 eq 'left' ) {
	246	$start = $x1 - $offset + $diff;
	247	}
	248	else {
	249	$start = $col1_right + $diff;
	250	}
	251
	252	if ( $side2 eq 'left' ) {
	253	$end = $x2 - $offset + $diff;
	254	}
	255	else {
	256	$end = $col2_right + $diff;
	257	}
	258
	259	push @shapes, [ 'line', $x1, $y1, $start, $y1, 'lightblue' ];
	260	push @shapes, [ 'line', $start, $y1, $end, $y2, 'lightblue' ];
	261	push @shapes, [ 'line', $end, $y2, $x2, $y2, 'lightblue' ];
	262	$done{ $fno1 }{ $fno2 } = 1;
	263	$done{ $fno2 }{ $fno1 } = 1;
	264	}
	265	}
	266	}
	267	}
	268
	269	#
dd9550a4	270	# Add the title and signature.
	271	#
	272	my $large_font = gdLargeFont;
	273	my $title_len = $large_font->width * length $title;
aa0a19b9	274	push @shapes, [
	275	'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black'
	276	];
dd9550a4	277
aa0a19b9	278	my $sig = "auto-dia.pl $VERSION";
	279	my $sig_len = $font->width * length $sig;
	280	push @shapes, [
	281	'string', $font, $max_x - $sig_len, $max_y - $font->height - 4,
	282	$sig, 'black'
	283	];
dd9550a4	284
aa0a19b9	285	#
	286	# Render the image.
	287	#
dd9550a4	288	my $gd = GD::Image->new( $max_x + 10, $max_y );
	289	unless ( $gd->can( $image_type ) ) {
	290	die "GD can't create images of type '$image_type'\n";
	291	}
aa0a19b9	292	my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } (
	293	[ white => [ 255, 255, 255 ] ],
	294	[ black => [ 0, 0, 0 ] ],
	295	[ lightblue => [ 173, 216, 230 ] ],
	296	);
dd9550a4	297	$gd->interlaced( 'true' );
aa0a19b9	298	$gd->fill( 0, 0, $colors{ 'white' } );
dd9550a4	299	for my $shape ( @shapes ) {
dd9550a4	300	my $method = shift @$shape;
aa0a19b9	301	my $color = pop @$shape;
aa0a19b9	302	$gd->$method( @$shape, $colors{ $color } );
dd9550a4	303	}
dd9550a4	304
aa0a19b9	305	#
	306	# Print the image.
	307	#
dd9550a4	308	if ( $out_file ) {
	309	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
	310	print $fh $gd->$image_type;
	311	close $fh;
	312	print "Image written to '$out_file'. Done.\n";
	313	}
	314	else {
	315	print $gd->$image_type;
	316	}
	317
	318	=pod
	319
	320	=head1 AUTHOR
	321
	322	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	323
	324	=cut