use SQL::Abstract; use Data::Dumper; use DBD::SQLite; use Test::More; use strict; use warnings; my $tablename = 'atable'; my $dbfile = 'tmp.sqlite'; my $dbh = create_mock_table($tablename, $dbfile); my $WHERE = undef; #{ 'c3' => ['c','ccc'] }; db_modify_column_value( $dbh, $tablename, [qw/c1 c2/], # the columns to modify with below sub sub { my ($arow, $colnames) = @_; return { map { $_ => uc $arow->{$_} } @$colnames} }, $WHERE ); my $results = fetchrows_mock_table($dbh, $tablename); my @expected_results = ( {'id' => 1, 'c1' => 'A', 'c2' => 'B', 'c3' => 'c'}, {'id' => 2, 'c1' => 'AA', 'c2' => 'BB', 'c3' => 'cc'}, {'id' => 3, 'c1' => 'AAA', 'c2' => 'BBB', 'c3' => 'ccc'}, # replicate a row which will processed {'id' => 4, 'c1' => 'A', 'c2' => 'B', 'c3' => 'c'}, ); is_deeply($results, \@expected_results, "result is as expected for no WHERE"); # now test with a WHERE $dbh = create_mock_table($tablename, $dbfile); $WHERE = { 'c3' => ['c','ccc'] }; db_modify_column_value( $dbh, $tablename, [qw/c1 c2/], # the columns to modify with below sub sub { my ($arow, $colnames) = @_; return { map { $_ => uc $arow->{$_} } @$colnames} }, $WHERE ); $results = fetchrows_mock_table($dbh, $tablename); # now test with a WHERE @expected_results = ( {'id' => 1, 'c1' => 'A', 'c2' => 'B', 'c3' => 'c'}, # the WHERE will not select this row, so it is not modified {'id' => 2, 'c1' => 'aa', 'c2' => 'bb', 'c3' => 'cc'}, {'id' => 3, 'c1' => 'AAA', 'c2' => 'BBB', 'c3' => 'ccc'}, # replicate a row which will processed {'id' => 4, 'c1' => 'A', 'c2' => 'B', 'c3' => 'c'}, ); is_deeply($results, \@expected_results, "result is as expected with a WHERE"); $dbh->disconnect; done_testing; # It will modify all values of columns @$colnames # of table $tablename # by calling &$subexec on each table row # selected by the optional $WHERE # dies on error sub db_modify_column_value { my ($dbh, $tablename, $colnames, $subexec, $WHERE) = @_; print "called for table '$tablename' and cols: '@$colnames' ...\n"; my $abstSEL = SQL::Abstract->new(); my ($stmt, @bind) = $abstSEL->select($tablename, '', $WHERE); my $sth = $dbh->prepare($stmt); if( ! $sth->execute(@bind) ){ die "select: ".$dbh->errstr } # do the modifications and store results in a temp array my @updates; while( my $row = $sth->fetchrow_hashref() ){ print "$0 : Processing row: ".Dumper($row)."\n"; my $orirow_only_colnames = { %{ $row }{@$colnames} }; # $subexec is a subref which takes the row as a hashref # and returns a modified clone of it to be inserted into the db # so, newrow and row have the same keys exactly my $newrow = $subexec->($row, $colnames); print "$0 : result is: ".Dumper($newrow)."\n"; my $newrow_only_colnames = { %{ $newrow }{@$colnames} }; push @updates, [ $orirow_only_colnames, $newrow_only_colnames ]; } # now update # this will update multiple rows possibly # we should be able to rollback in case of errors $dbh->{AutoCommit} = 0; # $dbh->begin_work; my $abstUP = SQL::Abstract->new(); for my $ups (@updates){ my ($orirow_only_colnames, $newrow_only_colnames) = @$ups; my ($extraWHERE, @extrabind) = $abstUP->where($orirow_only_colnames); if( defined $WHERE ){ $extraWHERE =~ s/^\s*WHERE\s*//g; } my($stmt, @bind) = $abstUP->update($tablename, $newrow_only_colnames, $WHERE); if( defined $WHERE ){ $stmt .= ' AND ' } $stmt .= $extraWHERE; my @allbind = (@bind, @extrabind); print "executing SQL:\n$stmt\nwith binds:\n@allbind\n"; $sth = $dbh->prepare($stmt); if( ! $sth->execute(@allbind) ){ $dbh->rollback(); die "update (and rolling back): ".$dbh->errstr; } } $dbh->commit(); print "db_modify_column_value() : committed and returning.\n"; return 1; # success } sub create_mock_table { my ($tablename, $dbfile) = @_; unlink $dbfile; my $dbh = DBI->connect("dbi:SQLite:dbname=${dbfile}","","") || die "Cannot create handle: $DBI::errstr\n"; my @tabledata = ( {'id' => 1, 'c1' => 'a', 'c2' => 'b', 'c3' => 'c'}, {'id' => 2, 'c1' => 'aa', 'c2' => 'bb', 'c3' => 'cc'}, {'id' => 3, 'c1' => 'aaa', 'c2' => 'bbb', 'c3' => 'ccc'}, # replicate a row {'id' => 4, 'c1' => 'A', 'c2' => 'B', 'c3' => 'c'}, ); my ($stmt, @bind, $sth); $stmt = "CREATE TABLE IF NOT EXISTS ${tablename} (id INTEGER PRIMARY KEY, c1 varchar(10), c2 varchar(10), c3 varchar(10));"; $sth = $dbh->prepare($stmt); if( ! $sth->execute(@bind) ){ die "mock-create: ".$dbh->errstr } # do insert my $abstTEST = SQL::Abstract->new; for my $arow (@tabledata){ ($stmt, @bind) = $abstTEST->insert($tablename, $arow); print "create_mock_table() : executing $stmt (@bind).\n"; my $sth = $dbh->prepare($stmt); if( ! $sth->execute(@bind) ){ die "mock-insert: ".$dbh->errstr } } return $dbh } sub fetchrows_mock_table { my ($dbh, $tablename) = @_; my $abstTEST = SQL::Abstract->new; my ($stmt, @bind) = $abstTEST->select($tablename, ''); print "fetchrows_mock_table() : executing $stmt.\n"; my $sth = $dbh->prepare($stmt); if( ! $sth->execute(@bind) ){ die "fetchrows_mock_table() : select: ".$dbh->errstr } my @results; while( my $row = $sth->fetchrow_hashref() ){ push @results, $row; } # sort results wrt id because in order to compare @results = sort { $a->{'id'} <=> $b->{'id'} } @results; return \@results }