view release on metacpan or  search on metacpan

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

package DBIx::XHTML_Table;

use strict;
use warnings;
our $VERSION = '1.49';

use DBI;
use Carp;

# GLOBALS
use vars qw(%ESCAPES $T $N);
($T,$N)  = ("\t","\n");
%ESCAPES = (
    '&' => '&',
    '<' => '&lt;',
    '>' => '&gt;',
    '"' => '&quot;',
);

#################### CONSTRUCTOR ###################################

# see POD for documentation
sub new {
    my $class = shift;
    my $self  = {
        null_value => '&nbsp;',
    };
    bless $self, $class;

    # last arg might be GTCH (global table config hash)
    $self->{'global'} = pop if ref $_[$#_] eq 'HASH';

    # note: disconnected handles aren't caught :(

    if (UNIVERSAL::isa($_[0],'DBI::db')) {
        # use supplied db handle
        $self->{'dbh'}        = $_[0];
        $self->{'keep_alive'} = 1;
    } 
    elsif (ref($_[0]) eq 'ARRAY') {
        # go ahead and accept a pre-built 2d array ref
        $self->_do_black_magic(@_);
    }
    else {
        # create my own db handle
        eval { $self->{'dbh'} = DBI->connect(@_) };
        carp $@ and return undef if $@;
    }

    return $self;
}

#################### OBJECT METHODS ################################

sub exec_query {
    my ($self,$sql,$vars) = @_;

    carp "can't call exec_query(): do database handle" unless $self->{'dbh'};

    eval {
        $self->{'sth'} = (UNIVERSAL::isa($sql,'DBI::st'))
            ? $sql
            : $self->{'dbh'}->prepare($sql)
        ;
        $self->{'sth'}->execute(@$vars);
    };
    carp $@ and return undef if $@;

    # store the results
    $self->{'fields_arry'} = [ @{$self->{'sth'}->{'NAME'}} ];
    $self->{'fields_hash'} = $self->_reset_fields_hash();
    $self->{'rows'}        = $self->{'sth'}->fetchall_arrayref();
    carp "can't call exec_query(): no data was returned from query" unless @{$self->{'rows'}};

    if (exists $self->{'pk'}) {
        # remove the primary key info from the arry and hash
        $self->{'pk_index'} = delete $self->{'fields_hash'}->{$self->{'pk'}};
        splice(@{$self->{'fields_arry'}},$self->{'pk_index'},1) if defined $self->{'pk_index'};
    }

    return $self;
}

sub output {
    my ($self,$config,$no_ws) = @_;
    carp "can't call output(): no data" and return '' unless $self->{'rows'};

    # have to deprecate old arguments ...
    if ($no_ws) {
        carp "scalar arguments to output() are deprecated, use hash reference";
        $N = $T = '';
    }
    if ($config and not ref $config) {
        carp "scalar arguments to output() are deprecated, use hash reference";
        $self->{'no_head'} = $config;
    }
    elsif ($config) {
        $self->{'no_head'}    = $config->{'no_head'};

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

sub _xml_encode {
    my ($self,$str) = @_;
    $str =~ s/([&<>"])/$ESCAPES{$1}/ge;
    return $str;
}

# returns value of and moves first element to last
sub _rotate {
    my $ref  = shift;
    my $next = shift @$ref;
    push @$ref, $next;
    return $next;
}

# always returns an array ref
sub _refinate {
    my ($self,$ref) = @_;
    $ref = undef if ref($ref) eq 'ARRAY' && scalar( @$ref ) < 1;
    $ref = [@{$self->{'fields_arry'}}] unless defined $ref;
    $ref = [$ref] unless ref $ref eq 'ARRAY';
    return [map {$_ =~ /^\d+$/ ? $self->_lookup_name($_) || $_ : $_} @$ref];
}

sub _merge_attribs {
    my ($hash1,$hash2) = @_;

    return $hash1 unless $hash2;
    return $hash2 unless $hash1;

    return {%$hash2,%$hash1};
}

sub _lookup_name {
    my ($self,$index) = @_;
    return $self->{'fields_arry'}->[$index];
}

sub _lookup_index {
    my ($self,$name) = @_;
    return $self->{'fields_hash'}->{$name};
}

sub _reset_fields_hash {
    my $self = shift;
    my $i    = 0;
    $self->{fields_hash} = { map { $_ => $i++ } @{$self->{fields_arry}} };
}

# assigns a non-DBI supplied data table (2D array ref)
sub _do_black_magic {
    my ($self,$ref,$headers) = @_;
    croak "bad data" unless ref( $ref->[0] ) eq 'ARRAY';
    $self->{'fields_arry'} = $headers ? [@$headers] : [ @{ shift @$ref } ];
    $self->{'fields_hash'} = $self->_reset_fields_hash();
    $self->{'rows'}        = $ref;
}

# disconnect database handle if i created it
sub DESTROY {
    my ($self) = @_;
    unless ($self->{'keep_alive'}) {
        $self->{'dbh'}->disconnect if defined $self->{'dbh'};
    }
}

1;
__END__

=head1 NAME

DBIx::XHTML_Table - SQL query result set to XHTML table.

=head1 SYNOPSIS

  use DBIx::XHTML_Table;

  # database credentials - fill in the blanks
  my ($data_source,$usr,$pass) = ();

  my $table = DBIx::XHTML_Table->new($data_source,$usr,$pass);

  $table->exec_query("
      select foo from bar
      where baz='qux'
      order by foo
  ");

  print $table->output();

  # stackable method calls:
  print DBIx::XHTML_Table
    ->new($data_source,$usr,$pass)
    ->exec_query('select foo,baz from bar')
    ->output();

  # and much more - read on ...

=head1 DESCRIPTION

B<DBIx::XHTML_Table> is a DBI extension that creates an HTML
table from a database query result set. It was created to fill
the gap between fetching data from a database and transforming
that data into a web browser renderable table. DBIx::XHTML_Table is
intended for programmers who want the responsibility of presenting
(decorating) data, easily. This module is meant to be used in situations
where the concern for presentation and logic seperation is overkill.
Providing logic or editable data is beyond the scope of this module,
but it is capable of doing such.

=head1 CODE FREEZE

For the most part, no new functionality will be added to this module.
Only bug fixes and documentation corrections/additions. All new efforts
will be directed towards the rewrite of this distribution, B<DBIx::HTML>.

This distribution features a more flexible interface with fewer methods and
logically named argument parameters. At the core is an HTML attribute generator:

=over 4

=item * L<Tie::Hash::Attribute>