#!/usr/bin/perl

# Quick hack to dump tables to HTML.
$TableDump::REVISION = '$Id: tableDump,v 1.3 2004/05/03 21:15:01 eric Exp $ ';

use strict;

package TableDump;
use Getopt::Long;
use Pod::Usage;
use DBI;

@HTMLPresenter::ISA = qw(Presenter);

use vars qw($C_NADA $C_USER $C_PASSWORD);
($C_NADA, $C_USER, $C_PASSWORD) = (\ 'C_NADA', \ 'C_USER', \ 'C_PASSWORD');

# HELP OPTIONS
my ($help, $man);

# DUMP OPTIONS
my $OPT_Limit = 0;
my $OPT_Indent = 4;
my $OPT_HouseStyle = 0;
my $OPT_TypeStyle = 0;
my $OPT_Scope = 0;
my $OPT_Label = 0;
my $OPT_Heading = undef;

# CONNECT OPTIONS
my $OPT_Host = undef;
my $OPT_Password = undef;
my $OPT_Port = undef;
my $OPT_User = undef;

my $STATE_Database = undef;
my $STATE_Expect = $C_NADA;
my $STATE_Handle = undef;
my $STATE_Presenter = undef;
my $STATE_Visited = {};

my $IntOptionSpec = $Getopt::Long::VERSION >= 2.3 ? 'o' : 'i';

&Getopt::Long::Configure('gnu_getopt'); # 'debug'
my $res = &GetOptions("d=$IntOptionSpec" => \$OPT_Limit, 
		      'i=o' => \$OPT_Indent, 
		      'houseStyle!' => \$OPT_HouseStyle, 
		      'typeStyle!' => \$OPT_TypeStyle, 
		      'scope!' => \$OPT_Scope, 
		      'label!' => \$OPT_Label,  
		      'heading=s' => \$OPT_Heading, 
		      '<>' => \&processArg, 

		      # myslq interface
		      'h=s' => \$OPT_Host, 
		      'p=s' => \$OPT_Password, 
		      'password' => \$OPT_Password, 
		      'P=i' => \$OPT_Port, 
		      'u=s' => \$OPT_User, 
		      'user' => \$OPT_User, 

		      # help commands
		      'help|?' => \$help, 
		      'man' => \$man);

&pod2usage(-exitstatus => 0, -verbose => 1) if $help;
&pod2usage(-exitstatus => 0, -verbose => 2) if $man;
&pod2usage(-exitstatus => 1, -verbose => 1, 
	   -message => "No database found.") if (!defined $STATE_Database);
&walkTables() if (!%$STATE_Visited); # Walk all the tables;
print $STATE_Presenter->toString();

sub processArg () {
    my ($arg) = @_;
    if ($STATE_Expect == $C_NADA) {
	if (defined $STATE_Database) {
	    &dumpQuery($arg);
	} else {
	    $STATE_Database = $arg;
	    &openConnection();
	    $STATE_Presenter = new HTMLPresenter(INDENT => $OPT_Indent, 
						 HOUSE_STYLE => $OPT_HouseStyle, 
						 TYPE_STYLE => $OPT_TypeStyle, 
						 SCOPE => $OPT_Scope, 
						 LABEL => $OPT_Label, 
						 HEADING => $OPT_Heading, 
						 );
	}
    } elsif ($STATE_Expect == $C_USER) {
	$OPT_User = $arg;
	$STATE_Expect = $C_NADA;
    } elsif ($STATE_Expect == $C_PASSWORD) {
	$OPT_Password = $arg;
	$STATE_Expect = $C_NADA;
    } else {
	die "unexpected state: $STATE_Expect";
    }
}

sub walkTables {
    my $query = "SHOW TABLES FROM $STATE_Database";
    my $sth = $STATE_Handle->prepare($query);
    if (!$sth->execute) {
	my $errStr = $sth->errstr;
	die "failed to \"$query\" -- error: \"$errStr\".\n"
    }
    my $numRows = $sth->rows;
    for (my $i = 0; $i < $numRows; $i++) {
	&dumpQuery($sth->fetchrow_array());
    }
    $sth->finish;
}

sub getMetaData {
    my ($query) = @_;
    my $sth = $STATE_Handle->prepare($query);
    if (!$sth->execute) {
	my $errStr = $sth->errstr;
	die "failed to \"$query\" -- error: \"$errStr\".\n"
    }
    my $numRows = $sth->rows;
    for (my $i = 0; $i < $numRows; $i++) {
	$STATE_Presenter->meta($sth->fetchrow_array(), $query);
    }
    $sth->finish;
}

sub openConnection {
    my ($host, $port) = ($OPT_Host, $OPT_Port);
    $port = 3306 if (!defined $port);
    my $connectString = 'DBI:mysql:'.$STATE_Database.':'.$host.':'.$port;
    $STATE_Handle = DBI->connect($connectString, $OPT_User, $OPT_Password, {'RaiseError' => 0, 'PrintError' => 0}) || 
	die "could not connect to \"$connectString\"";
}

sub dumpQuery {
    my ($tableName) = @_;
    my $query;
    my $metaQueries = [];
    if ($tableName =~ m/ /) {
	$query = $tableName;
    } else {
	push (@$metaQueries, "SHOW COLUMNS FROM $tableName");
	$query = "SELECT * FROM $tableName";
    }
    my $sth = $STATE_Handle->prepare($query);
    if (!$sth->execute) {
	my $errStr = $sth->errstr;
	die "failed to \"$query\" -- error: \"$errStr\".\n"
    }
    my $numRows = $sth->rows;
    $STATE_Presenter->startTable($tableName, $numRows);
    foreach my $metaQuery (@$metaQueries) {
	&getMetaData($metaQuery);
    }
    for (my $i = 0; $i < $numRows; $i++) {
	$STATE_Presenter->row([$sth->fetchrow_array()]);
    }
    $STATE_Presenter->endTable();
    $sth->finish;
    $STATE_Visited->{$tableName} = $numRows;
}

package Presenter;

sub new {
    my ($proto, %args) = @_;
    my $class = ref($proto) || $proto;
    my $self  = {%args, ROWS => [], 
		 PREFIX_STR => (' ' x $args{INDENT})};
    bless ($self, $class);
    return $self;
}

sub printRow {
    my ($self, $str) = @_;
    push (@{$self->{ROWS}}, $str);
}

sub printDatum {
    my ($self, $str) = @_;
    $self->{ROWS}[-1] .= $str;
}

sub endRow {
    my ($self, $str) = @_;
    $self->{ROWS}[-1] .= $str;
}

sub toString {
    my ($self) = @_;
    return join("\n", map {"$self->{PREFIX_STR}$_"} @{$self->{ROWS}}),"\n";
}

package HTMLPresenter;

sub new {
    my ($proto, @args) = @_;
    my $class = ref($proto) || $proto;
    my $self  = $class->SUPER::new(@args);
    $self->_clearData();
    $self->{STYLE_table} = $self->{HOUSE_STYLE} ? " style=\"tD_table\"" : '';
    $self->{STYLE_thead} = $self->{HOUSE_STYLE} ? " style=\"tD_thead\"" : '';
    $self->{STYLE_tbody} = $self->{HOUSE_STYLE} ? " style=\"tD_tbody\"" : '';
    $self->{STYLE_tr} = $self->{HOUSE_STYLE} ? " style=\"tD_tr\"" : '';
    $self->{STYLE_th} = $self->{HOUSE_STYLE} ? " style=\"tD_th\"" : '';
    $self->{STYLE_td} = $self->{HOUSE_STYLE} ? 'tD_td' : '';
    $self->{SCOPE_heading} = $self->{SCOPE} ? " scope=\"col\"" : '';
    $self->{SCOPE_row} = $self->{SCOPE} ? " scope=\"row\"" : '';
    return $self;
}

sub _clearData {
    my ($self) = @_;
    $self->{DATA} = [];
    $self->{WIDTHS} = [];
    $self->{META} = [];
}

sub startTable {
    my ($self, $name, $rows) = @_;
    $self->printRow("<$self->{HEADING} ID=\"$name\">$name</$self->{HEADING}>") if ($self->{HEADING});
    my $idString = $self->{LABEL} ? " ID=\"$name\"" : '';
    $self->printRow("<table$self->{STYLE_table}$idString>");
}

sub meta {
    my ($self, $field, $mysql_type, $null, $key, $default, $extra, $query) = @_;
    my ($type, $size);
    if ($mysql_type =~ m/^(\w+)\((\d+)\)/) {
	($type, $size) = ($1, $2);
    } elsif ($mysql_type =~ m/^text$/) {
	($type, $size) = ('text', undef);
    } elsif ($mysql_type =~ m/^date$/) {
	($type, $size) = ('date', undef);
    } elsif ($mysql_type =~ m/^enum\(\'([^\)]+)\)$/) {
	my $types = $1;
	chop $types; # get rid of last "'"
	($type, $size) = ('enum', 0);
	foreach my $enum (split("','", $types)) {
	    if ($size < length $enum) {
		$size = length $enum;
	    }
	}
    } else {
	die "unknown datatype \"$mysql_type\" in table $query.\n";
    }
    my $meta = [$field, $type, $size];
    push (@{$self->{META}}, $meta);
    my $l = length $field;
    # account for scope="col"
    if (@{$self->{META}} > 1 && $self->{SCOPE}) {
	$l += length ' scope="col"'
    }
    $self->{WIDTHS}[@{$self->{META}} - 1] = $l;
}

sub row {
    my ($self, $row) = @_;
    push (@{$self->{DATA}}, $row);
    for (my $i = 0; $i < @$row; $i++) {
	my $l = length $row->[$i];
	if ($l > $self->{WIDTHS}[$i]) {
	    $self->{WIDTHS}[$i] = $l;
	}
    }
}

sub endTable {
    my ($self) = @_;
    if (@{$self->{META}}) {
	$self->printRow("  <thead$self->{STYLE_thead}>");
	$self->printRow("    <tr$self->{STYLE_tr}>");
	for (my $i = 0; $i < @{$self->{META}}; $i++) {
	    my ($field, $type, $size) = @{$self->{META}[$i]};
	    my $l = length $field;
	    if ($i > 0 && $self->{SCOPE}) {
		$l += length ' scope="col"';
	    }
	    my $pad = ' ' x ($self->{WIDTHS}[$i] - $l);
	    my $scopeStr = $self->{SCOPE_heading};
	    my $styles = [];
	    push (@$styles, $self->{STYLE_th}) if ($self->{STYLE_th});
	    push (@$styles, $self->{META}[$i][1]) if ($self->{TYPE_STYLE});
	    my $styleStr = @$styles ? ' class="'.join (' ', @$styles).'"' : '';
	    $self->printDatum("<th$scopeStr$styleStr>$field</th>$pad");
	}
	$self->printDatum("    </tr>");
	$self->printRow("  </thead>");
    }

    $self->printRow("  <tbody$self->{STYLE_tbody}>");
    foreach my $row (@{$self->{DATA}}) {
	$self->printRow("    <tr$self->{STYLE_tr}>");
	for (my $i = 0; $i < @$row; $i++) {
	    my $field = $row->[$i];
	    my $pad = ' ' x ($self->{WIDTHS}[$i] - (length $field));
	    my $scopeStr = $i == 0 ? $self->{SCOPE_row} : '';
	    my $styles = [];
	    push (@$styles, $self->{STYLE_td}) if ($self->{STYLE_td});
	    push (@$styles, $self->{META}[$i][1]) if ($self->{TYPE_STYLE});
	    my $styleStr = @$styles ? ' class="'.join (' ', @$styles).'"' : '';
	    $self->printDatum("<td$scopeStr$styleStr>$field</td>$pad");
	}
	$self->endRow("</tr>");
    }
    $self->printRow("  </tbody>");
    $self->printRow("</table>");
    $self->printRow("");

    $self->_clearData();
}

__END__

=head1 NAME

tableDump - Simple utility to dump SQL results as HTML tables - similar to mysqldump -d.

=head1 SYNOPSIS

  tableDump [OPTIONS] DATABASE [TABLES...]

  tableDump -u bob bobzDB table1 table2

=head1 DESCRIPTION

This spits out HTML output after performing a SQL query.

=head1 OPTIONS

=over 8

=head2 DUMP OPTIONS

=item B<-l>

Limit of result count.

=item B<-i>

Spaces to indent.

=item B<--houseStyle>

Decorate classes with table identifiers.

=item B<--typeStyle>

Decorate classes with data types.

=item B<--scope>

Add column/row scope attributes to <th>s.

=item B<--label>

Add table name to tables.

=head2 HELP OPTIONS

=item B<-help>

Print a brief help message and exit.

=item B<-man>

Send the manual page to the $PAGER and exit.

=head2 CONNECT OPTIONS

Interface is similar to MySQL clients B<mysql>, B<mysqldump>, B<mysqladmin>

=item B<-h>

Connect to host

=item B<-p> B<--password[=name] >

Password to use when connecting to server. If password is not given it's asked from the tty.

=item B<-P> B<--port=#>

Port number to use for connection.

=item B<-u> B<--user[=name] >

User for login if not current user.

=back

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

Parse::Yapp(3) Term::ReadLine(3) perl(1).

=cut