Added to repository

[tpope-extra.git] / perl / relational-schema

diff --git a/perl/relational-schema b/perl/relational-schema
new file mode 100755 (executable)
index 0000000..be914f8
--- /dev/null
+++ b/perl/relational-schema
@@ -0,0 +1,140 @@
+#!/usr/bin/perl -w
+# $Id$
+# -*- perl -*- vim:set ft=perl sw=4 sts=4:
+
+# Usage: relational-schema out.png RELATION:_Primary_Key,.Foreign_Key,Etc
+# To clarifiy, specifiy the relation name, followed by a colon, followed by
+# the attributes seperated by commas.  Primary keys should be prefixed with
+# an underscore, and foreign keys with a period.
+# It is also possible to override or augment the functional dependencies by
+# adding a second colon and additional specifications.  Since this was
+# unnecessary for the assignment, it is not documented here.
+
+use strict;
+use Image::Imlib2;
+
+use vars qw($font $maxwidth $pd $fh);
+$font = "Verdana/11";
+$maxwidth = 550;
+$pd = 4;
+
+my $out = shift or die "No output file specified.\n";
+
+my @rows = @ARGV;
+die "No rows.\n" unless (@rows);
+
+my $image = new Image::Imlib2->new(1,1);
+$image->add_font_path ("/usr/share/fonts/truetype/msttcorefonts");
+$image->load_font($font);
+($fh, $fh) = $image->get_text_size("(Ay)");
+$image = new Image::Imlib2->new($maxwidth, ($#rows+1)*($fh*2+$pd*12+2));
+$image->add_font_path ("/usr/share/fonts/truetype/msttcorefonts");
+$image->load_font($font);
+$image->set_color(255,255,255,255);
+#$image->fill_rectangle(0,0,$maxwidth,($#rows+1)*($fh*2+$pd*12+2));
+
+sub draw_boxed_text {
+    my ($image, $text, $x, $y, $underline)=@_;
+    $image->load_font($font);
+    my ($w, $h) = $image->get_text_size($text);
+    $image->set_color(255,255,255,255);
+    $image->fill_rectangle($x,$y,$w+2*$pd+2,$fh+2*$pd+2);
+    $image->set_color(0,0,0,255);
+    $image->draw_rectangle($x,$y,$w+2*$pd+2,$fh+2*$pd+2);
+    $image->draw_text($x+$pd,$y+$pd,$text);
+    if(($underline||0)==1) {
+       $image->draw_line($x+$pd,$y+$pd+$fh,$x+$w+$pd,$y+$pd+$fh);
+    } elsif(($underline||0)==2) {
+       for(my $i=0;$i<$w;$i+=5) {
+           $image->draw_line($x+$pd+$i,$y+$pd+$fh,
+               $x+$pd+($i+2>$w?$w$i+2),$y+$pd+$fh);
+       }
+    }
+
+    return $w+2*$pd+1;
+}
+
+my $line=0;
+
+foreach my $row (@rows) {
+    my ($title,$element,@depends) = split (':',$row);
+    my @elements = split (',',$element);
+    my %elcenters = ();
+    my (@in,@out);
+    my ($toffset)=(2*$pd);
+    while ($title =~ s/^>//) {
+       $toffset += 16*$pd;
+    }
+    my ($offset) = ($toffset);
+    foreach $element (@elements) {
+       my $under=0;
+       if ($element =~ s/^_//) {
+           $under=1;
+           push @out,($element);
+       } elsif ($element =~ s/^\.//) {
+           $under=2;
+           push @in,($element);
+       } else {
+           push @in,($element);
+           warn "Element $element in $title not marked as ".
+           "primary or foreign key.\n" if ($element=~/_ID$/);
+       }
+       my $o=draw_boxed_text($image,$element,$offset,$line+$fh+5*$pd,$under);
+       $elcenters{$element}=($offset+$o/2);
+       $offset+=$o;
+    }
+    my $updown=0;
+    my $shifttitle=0;
+    if((($#depends>=0 and $depends[0] eq 'auto') or $#depends=-1)
+           and $#in>=0 and $#out>=0) {
+       $depends[0]=(join(",",@out)."/".join(",",@in));
+    } elsif($#depends>=0 and $depends[0] eq 'auto') {
+       shift @depends;
+    }
+    foreach my $depend (@depends) {
+       unless ($depend) {
+           $updown++;
+           next;
+       }
+       $image->set_color(0,(32*($updown>>1))%128,(64*($updown>>1))%256,255);
+       my ($out,$in) = split('/',$depend);
+       my ($near, $far);
+       my @out = split(',', $out);
+       my @in  = split(',', $in );
+       my @temp = sort { $elcenters{$a} <=> $elcenters{$b} } (@out, @in);
+       if($updown%2==1) {
+           $shifttitle=1;
+           $near=$line+$fh+5*$pd-1;
+           $far=$line+$fh+1*$pd-1;
+       } else {
+           $near=$line+2*$fh+7*$pd+2;
+           $far=$line+2*$fh+11*$pd+2;
+       }
+       $image->draw_line($elcenters{$temp[0]}+$pd*($updown>>1),
+           $far,$elcenters{$temp[$#temp]}+$pd*($updown>>1),$far);
+       foreach $out (@out) {
+           $image->draw_line($elcenters{$out}+$pd*($updown>>1),
+               $far,$elcenters{$out}+$pd*($updown>>1),$near);
+       }
+       foreach $in (@in) {
+           my $arrow = Image::Imlib2::Polygon->new();
+           $arrow->add_point($elcenters{$in}+$pd*($updown>>1),$near);
+           $arrow->add_point($elcenters{$in}+$pd+$pd*($updown>>1),
+               ($near+$far)/2);
+           $arrow->add_point($elcenters{$in}-$pd+$pd*($updown>>1),
+               ($near+$far)/2);
+           $arrow->add_point($elcenters{$in},$near);
+           $arrow->fill();
+           $image->draw_line($elcenters{$in}+$pd*($updown>>1),
+               $far,$elcenters{$in}+$pd*($updown>>1),$near);
+           $image->draw_polygon($arrow,1);
+       }
+       $updown++;
+    }
+    $image->set_color(0,0,0,255);
+    $image->draw_text($toffset+$pd*2,$line+4*$pd-$shifttitle*(7*$pd/2),$title);
+    $line+=2*$fh+12*$pd+2;
+}
+
+
+$image->save($out);