Class-Classless-DBI
view release on metacpan or search on metacpan
lib/Class/Classless/DBI.pm view on Meta::CPAN
# TO DO:
# - Pester David about SQL::Interpolate
sub delete_from_table {
my($self,$next,$vars) = @_;
return $self->dbx->do('
DELETE FROM', $self->table, 'WHERE',
@{ $self->make_where_clause($vars) }
);
}
sub insert_into_table {
my($self,$next,$vars) = @_;
my $values = $vars->{from} = $vars->{values};
my $columns = $vars->{columns};
my $row = ref $values eq 'ARRAY' ? $values->[0] : $values;
$self->dbx->do('
INSERT IGNORE INTO', $self->table,
'(', join(',', map {$columns->{$_} || $_} keys %$row), ')
SELECT * FROM', @{ $self->make_from_clause($vars) }
);
}
sub select_from_table {
my($self,$next,$vars) = @_;
my(@select,@group);
my $select = $vars->{select};
my $group = $vars->{group};
if($select) {
@select = map {$_,','} @$select;
pop @select;
} else {
@select = qw(*);
}
if($group) {
@group = ('GROUP BY', map {$_,','} @$group);
pop @group;
} elsif($select) {
@group = ('GROUP BY', @select);
} else {
@group = ();
}
return $self->dbx->selectall_arrayref('
SELECT', @select, 'FROM', $self->table, '
WHERE', @{ $self->make_where_clause($vars) },
@group,
DBIx::Interpolate::attr(Columns=>{})
);
}
sub update_table {
my($self,$next,$vars) = @_;
return $self->dbx->do('
UPDATE', $self->table, 'SET', $vars->{values}, '
WHERE', @{ $self->make_where_clause($vars) }
);
}
sub make_where_clause {
my($self,$next,$vars) = @_;
my $where = $vars->{where} || return ['1=1'];
my $columns = $vars->{columns};
my @ret = ();
foreach my $subtable (ref $where eq 'ARRAY' ? @$where : $where) {
push @ret, map {
({$columns->{$_} || $_ => $subtable->{$_}}, 'AND')
} keys %$subtable;
scalar %$subtable ? pop @ret : push @ret, '1=1';
push @ret, 'OR';
}
pop @ret;
return \@ret if(@ret);
return ['1=0'];
}
# most of this will be replaced by SQL::Interpolate
# make this work with table names
sub make_from_clause {
my($self,$next,$vars) = @_;
my $from = $vars->{from};
my $columns = $vars->{columns};
my @from = ();
foreach my $subtable (ref $from eq 'ARRAY' ? @$from : $from) {
foreach my $col (keys %$subtable) {
my $tmp = $subtable->{$col};
my @tmp = (ref $tmp eq 'ARRAY' ? @$tmp : $tmp);
push @from, '(';
push @from, map {
('SELECT', \$_, 'UNION ALL')
} @tmp;
push @from, ') as', $columns->{$col} || $col, 'JOIN' if('(' ne pop @from);
}
pop @from;
push @from, 'UNION ALL' if(scalar %$subtable);
}
pop @from;
return \@from;
}
( run in 2.043 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )