view release on metacpan or  search on metacpan

testme.tmp.pl  view on Meta::CPAN

use 5.008001;
use strict;
use warnings;
use DBI ':sql_types';
use utf8;
use Data::Dumper;
use YAML;
use DBD::Pg qw/:pg_types/;
use Data::Peek;
use Devel::Leak;
use Time::HiRes qw/ sleep /;

my $DBPORT = shift || 6432;

our ($sth, $info, $count, $SQL);

my $tracelevel = shift || 0;
$ENV{DBI_TRACE} = $tracelevel;

my $DSN = "DBI:Pg:dbname=postgres;port=$DBPORT";
my $dbh = DBI->connect($DSN, '', '', {AutoCommit=>0,RaiseError=>1,PrintError=>0})
  or die "Connection failed!\n";

my $me = $dbh->{Driver}{Name};
my $sversion = $dbh->{pg_server_version};
print "DBI is version $DBI::VERSION, I am $me, version of DBD::Pg is $DBD::Pg::VERSION, server is $sversion\n";
my $port = $dbh->{pg_port};
print "Port: $port\n";

print "Name: $dbh->{Name}\n";

$dbh->{RaiseError} = 0;
$dbh->{PrintError} = 1;
$dbh->{AutoCommit} = 1;

update_rule_return();

exit;

#column_types_github_issue_24();

#read_only_arrays();

# bad_string_length();

# jsonb_placeholder();

#fatal_client();

#user_arrays();

#commit_return_test();

#utf8_print_test();

#memory_leak_test_bug_65734();

#memory_leak_arrays();


sub update_rule_return {

my @statements = (
    q[DROP TABLE IF EXISTS test CASCADE],
    q[CREATE TABLE test(id int primary key, animal text, sound text)],
    q[CREATE VIEW test_view AS SELECT * FROM test],
    q[CREATE OR REPLACE RULE test_fallback AS ON UPDATE TO test_view
        DO INSTEAD NOTHING],
    q[CREATE RULE test_deny AS ON UPDATE TO test_view
        WHERE NEW.animal = OLD.animal
        DO INSTEAD (SELECT true)],
    q[CREATE OR REPLACE RULE test_allow AS ON UPDATE TO test_view
        WHERE NEW.animal <> OLD.animal
        DO INSTEAD (
            UPDATE test SET animal = NEW.animal,
            sound = NEW.sound
            WHERE id = OLD.id;
            SELECT true;
        )],
    q[INSERT into test VALUES (1,'rabbit','purr'),(2,'fox','shriek')],
);

foreach my $statement (@statements) {
    $dbh->do($statement);
}

sub is {
my ($got, $expected, $name) = @_;

warn "OK: $name\n" and return if $got eq $expected;
warn "Failed test: got ($got) expected ($expected) for $name\n";
}

my ($found,$animal,$sound);
my $sth_s = $dbh->prepare('SELECT animal,sound FROM test WHERE id = ?');
my $sth_u = $dbh->prepare('UPDATE test_view SET animal = ?, sound = ? WHERE id = ?', {});
#,{ pg_server_prepare => 0} makes a difference ???

## PGRES_TUPLES_OK vs PGRES_COMMAND_OK

## How does psql do the right thing?

# Test update that will be allowed by rule
print "Normal UPDATE\n";
my ($rv2) = $sth_u->execute('bear','roar',1);
$sth_s->execute(1);
($animal,$sound) = $sth_s->fetchrow_array();
$sth_s->finish;
is($animal,'bear','animal ok');
is($sound,'roar','sound was changed');
is($sth_u->state,'','state ok');
is($sth_u->rows,1,'1 rows');
is($rv2,1,'rv is 1');
is($sth_u->{Active},1,'Sth active');
is($sth_u->fetch->[0],1,'Row was found: TWO');
$sth_u->finish();

exit;


# Test update that will be denied by rule