From: Ken Youens-Clark Date: Fri, 18 Jul 2003 22:54:17 +0000 (+0000) Subject: Added options to make an image map. X-Git-Tag: v0.04~374 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a20798b3cbca00f2d7d37b9d1b3de3d91bb26df;p=dbsrgits%2FSQL-Translator.git Added options to make an image map. --- diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm index c3da38d..4f2b4a9 100644 --- a/lib/SQL/Translator/Producer/Diagram.pm +++ b/lib/SQL/Translator/Producer/Diagram.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::Diagram; # ------------------------------------------------------------------- -# $Id: Diagram.pm,v 1.3 2003-06-09 04:40:50 kycl4rk Exp $ +# $Id: Diagram.pm,v 1.4 2003-07-18 22:54:17 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -27,7 +27,7 @@ use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug); use vars qw[ $VERSION $DEBUG ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use constant VALID_FONT_SIZE => { @@ -50,10 +50,12 @@ sub produce { debug("Schema =\n", Dumper( $schema )); debug("Producer args =\n", Dumper( $args )); - my $out_file = $args->{'out_file'} || ''; - my $image_type = $args->{'image_type'} || 'png'; - my $title = $args->{'title'} || $t->filename; - my $font_size = $args->{'font_size'} || 'medium'; + my $out_file = $args->{'out_file'} || ''; + my $image_type = $args->{'image_type'} || 'png'; + my $title = $args->{'title'} || $t->filename; + my $font_size = $args->{'font_size'} || 'medium'; + my $imap_file = $args->{'imap_file'} || ''; + my $imap_url = $args->{'imap_url'} || ''; my $no_columns = $args->{'no_columns'}; my $no_lines = $args->{'no_lines'}; my $add_color = $args->{'add_color'}; @@ -100,6 +102,7 @@ sub produce { my %table_x; # for max x of each table my $field_no; # counter to give distinct no. to each field my %coords; # holds fields coordinates + my @imap_coords; # for making clickable image map my %legend; for my $table ( @tables ) { @@ -107,7 +110,6 @@ sub produce { 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; @@ -175,6 +177,11 @@ sub produce { is_pk => $is_pk, fld_name => $orig_name, }; + + push @imap_coords, [ + $imap_url."#$table_name-$orig_name", + $this_col_x, $y - $font->height, $length, $y_link, + ]; } unless ( $natural_join ) { @@ -208,6 +215,12 @@ sub produce { ]; unshift @shapes, [ 'filledRectangle', @bounds, 'white' ]; } + + push @imap_coords, [ + $imap_url."#$table_name", + $bounds[0], $bounds[1], $this_max_x, $below_table_name, + ]; + push @shapes, [ 'rectangle', @bounds, 'black' ]; $max_x = $this_max_x if $this_max_x > $max_x; $y += 25; @@ -442,6 +455,22 @@ sub produce { } # + # Make image map. + # + debug("imap file = '$imap_file'"); + if ( $imap_file && @imap_coords ) { + open my $fh, ">$imap_file" or die "Can't write '$imap_file': $!\n"; + print $fh qq[\n]. + qq[\n]; + for my $rec ( @imap_coords ) { + my $href = shift @$rec; + print $fh q[\n]; + } + print $fh qq[]; + close $fh; + } + + # # Print the image. # if ( $out_file ) {