pretty(ish) pictures...

[prev] [thread] [next] [Date index for 2005/07/12]

Hi,

I made a thing to draw ascii tables from CDBI classes. Is it any use to
anyone? I've never contributed code to anything before, so any comments
would be appreciated.

it just exports ->ascii, which returns a
Class::DBI::WithPictures::Ascii::Picture, so if you use it in your CBDI
class, you can:

$pic = Test::DBI::Widget->ascii;
print $pic->table;

+---------+
| widget  |
+---------+
| *id     |
| thingy  |-> thingy
+---------+

print $pic->width;  #in number of letters
20

print $pic->height;  #in number of rows
6

It only deals with has_a relationships and it should probably draw a table
with values filled in if called as an object method, but it doesn't yet. I
was vaguely thinking that a Class::DBI::WithPictures::HTML and a
Class::DBI::WithPictures::SVG might be handy too?

Code below.

Cheers,

Cass.

----
package Class::DBI::WithPictures::Ascii::Picture;

use strict;
use warnings;

sub new
{
  my $class = shift;
  my $self = bless {}, $class;
  return $self;
}

sub table
{
  my ($self, $table) = @_;
  $self->{table} = $table if $table;
  return $self->{table};
}

sub width
{
   my ($self, $width) = @_;
   $self->{width} = $width if $width;
   return $self->{width};
}

sub height
{
   my ($self, $height) = @_;
   $self->{height} = $height if $height;
   return $self->{height};
}

1;


package Class::DBI::WithPictures::Ascii;

use strict;
use warnings;
use vars qw($VERSION @EXPORT);

use Class::DBI::WithPictures::Ascii::Picture;

our $VERSION = '0.01';

require Exporter;
*import = \&Exporter::import;
@EXPORT = qw(ascii);

sub ascii
  {
    my $self = shift;

    my $table = $self->table;
    my @cols = $self->columns;

    #longest row?
    my $width  = 0;
    foreach ($table, map {$_->name} @cols)
      {$width = length($_) if $width < length($_)}
    $width = $width+3;

    #get key info
    my $has_a = $self->meta_info('has_a');
    my $pk = $self->primary_column;

   #make ascii table
   my @rows;

   my $total_width = $width;
   foreach my $col (@cols)
     {
       my $row = $col->name;

      # add a* if PK
      $row = "*$row" if ($col->name eq $pk);

      # add border and pad with spaces
      $row = &_ascii_pad($row, $width);

      # add ->foreign_table if has_a
      $row .= '-> '.$has_a->{$col}->foreign_class->table
           if (defined $has_a->{$col});
      $total_width = length($row)
          if ($total_width < length($row));

      #add to the row array
      push @rows, $row;

     }

   #Sort rows. Alphabetical, except PK always on top.
   @rows = sort {$a =~/^\*.+$/ ||  $a cmp $b } @rows;

   #top / bottom
   my $crossbar = '+';
   my $i;
   for ($i = 1; $i<=$width; $i++)
     {
       $crossbar .= '-';
     }
   $crossbar.='+';

   unshift @rows,($crossbar, &_ascii_pad($table, $width), $crossbar);
   push @rows, $crossbar;

   my $pic = Class::DBI::WithPictures::Ascii::Picture->new();
   $pic->width($total_width);
   $pic->height($#rows+1);
   my $txt .= join "\n", @rows;
   $txt .= "\n\n";
   $pic->table($txt);

   return $pic;

  }

sub _ascii_pad
  {
    my ($txt, $width) = @_;

    $txt = '| '.$txt;

    for (my $i = length($txt); $i<=$width; $i++)
      {
        $txt .= ' ';
      }
    $txt .= '|';
    return $txt;
  }

1;