File Coverage

blib/lib/DBIx/HTML.pm
Criterion Covered Total %
statement 15 46 32.6
branch 0 14 0.0
condition 0 9 0.0
subroutine 5 10 50.0
pod 2 2 100.0
total 22 81 27.1


line stmt bran cond sub pod time code
1             package DBIx::HTML;
2 4     4   2782 use strict;
  4         7  
  4         121  
3 4     4   23 use warnings FATAL => 'all';
  4         6  
  4         225  
4             our $VERSION = '1.02';
5             our $AUTOLOAD;
6              
7 4     4   9738 use DBI;
  4         186685  
  4         273  
8 4     4   44 use Carp;
  4         8  
  4         285  
9 4     4   4402 use Spreadsheet::HTML;
  4         645506  
  4         2379  
10              
11             sub connect {
12 0     0 1   my $class = shift;
13             my $self = {
14             head => [],
15             rows => [],
16             dbh => undef,
17             sth => undef,
18             keep_alive => undef,
19             generator => Spreadsheet::HTML->new(
20 0   0 0     headings => sub { join(' ', map { ucfirst(lc($_)) } split ('_', shift || '')) }
  0            
21 0           ),
22             };
23              
24 0 0         if (UNIVERSAL::isa( $_[0], 'DBI::db' )) {
25             # use supplied db handle
26 0           $self->{dbh} = $_[0];
27 0           $self->{keep_alive} = 1;
28             } else {
29             # create my own db handle
30 0           eval { $self->{dbh} = DBI->connect( @_ ) };
  0            
31 0 0 0       croak $@ and return undef if $@;
32             }
33              
34 0           return bless $self, $class;
35             }
36              
37             sub do {
38 0     0 1   my $self = shift;
39 0           my ($sql, $args) = @_;
40              
41 0 0         croak "can't call do(): no database handle" unless $self->{dbh};
42              
43 0           eval {
44 0           $self->{sth} = $self->{dbh}->prepare( $sql );
45 0           $self->{sth}->execute( @$args );
46             };
47 0 0 0       croak $@ and return undef if $@;
48              
49 0           $self->{head} = $self->{sth}{NAME};
50 0           $self->{rows} = $self->{sth}->fetchall_arrayref;
51 0           $self->{generator}{data} = [ $self->{head}, @{ $self->{rows} } ];
  0            
52 0           return $self;
53             }
54              
55             sub AUTOLOAD {
56 0     0     my $self = shift;
57 0 0         croak "must connect() first" unless $self->isa( __PACKAGE__ );
58 0           (my $method = $AUTOLOAD) =~ s/.*:://;
59 0 0         croak "no such method $method for " . ref($self->{generator}) unless $self->{generator}->can( $method );
60 0           return $self->{generator}->$method( @_ );
61             }
62              
63             # disconnect database handle if i created it
64             sub DESTROY {
65 0     0     my $self = shift;
66 0 0 0       if (!$self->{keep_alive} and $self->{dbh}->isa( 'DBI::db' )) {
67 0           $self->{dbh}->disconnect();
68             }
69             }
70              
71             1;
72             __END__