Re: pretty(ish) pictures...

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

    nevertheless ASCII generating modules tend to go under the 'ACME'
tagline, i believe this one might be quite useful for quick
visualisation of tables and stuff. so, go on - submit to CPAN =3D)

    + keep the good work

       stelf

On 7/12/05, Caroline Johnston <johnston@xxxxxxxxxxxx.xxx.xx.xx> wrote:
> Hi,
>=20
> 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.
>=20
> it just exports ->ascii, which returns a
> Class::DBI::WithPictures::Ascii::Picture, so if you use it in your CBDI
> class, you can:
>=20
> $pic =3D Test::DBI::Widget->ascii;
> print $pic->table;
>=20
> +---------+
> | widget  |
> +---------+
> | *id     |
> | thingy  |-> thingy
> +---------+
>=20
> print $pic->width;  #in number of letters
> 20
>=20
> print $pic->height;  #in number of rows
> 6
>=20
> It only deals with has_a relationships and it should probably draw a tabl=
e
> 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?
>=20
> Code below.
>=20
> Cheers,
>=20
> Cass.
>=20
> ----
> package Class::DBI::WithPictures::Ascii::Picture;
>=20
> use strict;
> use warnings;
>=20
> sub new
> {
>   my $class =3D shift;
>   my $self =3D bless {}, $class;
>   return $self;
> }
>=20
> sub table
> {
>   my ($self, $table) =3D @_;
>   $self->{table} =3D $table if $table;
>   return $self->{table};
> }
>=20
> sub width
> {
>    my ($self, $width) =3D @_;
>    $self->{width} =3D $width if $width;
>    return $self->{width};
> }
>=20
> sub height
> {
>    my ($self, $height) =3D @_;
>    $self->{height} =3D $height if $height;
>    return $self->{height};
> }
>=20
> 1;
>=20
>=20
> package Class::DBI::WithPictures::Ascii;
>=20
> use strict;
> use warnings;
> use vars qw($VERSION @EXPORT);
>=20
> use Class::DBI::WithPictures::Ascii::Picture;
>=20
> our $VERSION =3D '0.01';
>=20
> require Exporter;
> *import =3D \&Exporter::import;
> @EXPORT =3D qw(ascii);
>=20
> sub ascii
>   {
>     my $self =3D shift;
>=20
>     my $table =3D $self->table;
>     my @cols =3D $self->columns;
>=20
>     #longest row?
>     my $width  =3D 0;
>     foreach ($table, map {$_->name} @cols)
>       {$width =3D length($_) if $width < length($_)}
>     $width =3D $width+3;
>=20
>     #get key info
>     my $has_a =3D $self->meta_info('has_a');
>     my $pk =3D $self->primary_column;
>=20
>    #make ascii table
>    my @rows;
>=20
>    my $total_width =3D $width;
>    foreach my $col (@cols)
>      {
>        my $row =3D $col->name;
>=20
>       # add a* if PK
>       $row =3D "*$row" if ($col->name eq $pk);
>=20
>       # add border and pad with spaces
>       $row =3D &_ascii_pad($row, $width);
>=20
>       # add ->foreign_table if has_a
>       $row .=3D '-> '.$has_a->{$col}->foreign_class->table
>            if (defined $has_a->{$col});
>       $total_width =3D length($row)
>           if ($total_width < length($row));
>=20
>       #add to the row array
>       push @rows, $row;
>=20
>      }
>=20
>    #Sort rows. Alphabetical, except PK always on top.
>    @rows =3D sort {$a =3D~/^\*.+$/ ||  $a cmp $b } @rows;
>=20
>    #top / bottom
>    my $crossbar =3D '+';
>    my $i;
>    for ($i =3D 1; $i<=3D$width; $i++)
>      {
>        $crossbar .=3D '-';
>      }
>    $crossbar.=3D'+';
>=20
>    unshift @rows,($crossbar, &_ascii_pad($table, $width), $crossbar);
>    push @rows, $crossbar;
>=20
>    my $pic =3D Class::DBI::WithPictures::Ascii::Picture->new();
>    $pic->width($total_width);
>    $pic->height($#rows+1);
>    my $txt .=3D join "\n", @rows;
>    $txt .=3D "\n\n";
>    $pic->table($txt);
>=20
>    return $pic;
>=20
>   }
>=20
> sub _ascii_pad
>   {
>     my ($txt, $width) =3D @_;
>=20
>     $txt =3D '| '.$txt;
>=20
>     for (my $i =3D length($txt); $i<=3D$width; $i++)
>       {
>         $txt .=3D ' ';
>       }
>     $txt .=3D '|';
>     return $txt;
>   }
>=20
> 1;
>=20
>=20
>=20
>=20
>=20
>=20


--=20
    jr`