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 )