view release on metacpan or  search on metacpan

t/84-lob-populate-mixed.t  view on Meta::CPAN

  sub rollback   { 1 }
  sub err        { undef }
  sub errstr     { undef }

  sub do {
    my ($self, $sql) = @_;
    die "this connection binds no value without a type\n"
      if $sql =~ /where 1 = \?/ and not $TYPELESS;
    die "this connection takes no placeholders\n"
      if $sql =~ /\?/ and not $PLACEHOLDERS;
    return 1;
  }

  sub selectrow_arrayref { [ 1, 'DBMS_NAME', 'SQL Server' ] }
  sub selectrow_array    { $IDENTITY }

  sub quote {
    my ($self, $value) = @_;
    return 'NULL' unless defined $value;
    $value =~ s/'/''/g;
    return "'$value'";
  }

  sub prepare        { T::K81::STH->new($_[1]) }
  sub prepare_cached { T::K81::STH->new($_[1]) }
}

no warnings 'redefine';
local *DBI::connect = sub { T::K81::DBH->new };

local *DBIO::Sybase::Storage::ASE::LOBWriter::_insert_blobs = sub {
  my ($self, $source, $blob_cols, $row) = @_;
  push @SENT, { content => { %$blob_cols }, id => $row->{id} };
};
use warnings 'redefine';

$ENV{DBIO_SYBASE_FREETDS_NOWARN} = 1;

{
  package T::K81::Result::Lob;
  use base 'DBIO::Core';
  __PACKAGE__->table('k81_lob');
  __PACKAGE__->add_columns(
    id      => { data_type => 'integer', is_auto_increment => 1 },
    c_image => { data_type => 'image', is_nullable => 1 },
    c_text  => { data_type => 'text',  is_nullable => 1 },
  );
  __PACKAGE__->set_primary_key('id');
}

{
  package T::K81::Schema;
  use base 'DBIO::Schema';
  __PACKAGE__->load_components('Sybase');
  __PACKAGE__->register_class(Lob => 'T::K81::Result::Lob');
}

sub reset_records { @EXECUTED = @SENT = () }

sub inserts { grep { $_->{sql} =~ /\bINSERT INTO\b/ } @EXECUTED }
sub updates { grep { $_->{sql} =~ /\bUPDATE\b/ } @EXECUTED }

sub values_of {
  my ($list) = $_[0] =~ /\bVALUES\s*\((.*)\)/;
  return [ map { s/\A\s+|\s+\z//gr } split /,/, $list // '' ];
}

sub set_of {
  my ($list) = $_[0] =~ /\bSET\s+(.*?)\s+WHERE\b/s;
  return [ map { s/\A\s+|\s+\z//gr } split /,/, $list // '' ];
}

# the id an UPDATE is aimed at: bound, or (no placeholders) in the statement
sub id_of {
  my $u = shift;
  return $u->{bind}[0] if @{ $u->{bind} };
  return ($u->{sql} =~ /\[id\]\s*=\s*(\d+)/)[0];
}

# [ name, values of c_text per row ]
my @CASES = (
  [ 'undef, value',        [ undef, 'a' ]            ],
  [ 'value, undef',        [ 'a', undef ]            ],
  [ 'undef, value, undef', [ undef, 'a', undef ]     ],
  [ 'undef, empty, undef', [ undef, '', undef ]      ],
  [ 'value, undef, empty', [ 'a', undef, '' ]        ],
  [ 'all undef',           [ undef, undef ]          ],
  [ 'all value',           [ 'a', 'b' ]              ],
  [ 'all empty',           [ '', '' ]                ],
);

for my $client (
  [ 'Open Client, placeholders', $OPEN_CLIENT, 1, $ASE ],
  [ 'Open Client, no placeholders', $OPEN_CLIENT, 0, "${ASE}::NoBindVars" ],
) {
  (my $name, local $OC_VERSION, local $DYNAMIC, my $class) = @$client;
  local $PLACEHOLDERS = $DYNAMIC;

  my $schema  = T::K81::Schema->connect($DSN, 'sa', 's3cret');
  $schema->storage->ensure_connected;
  is ref $schema->storage, $class, "$name: (the storage is $class)";

  my $rs = $schema->resultset('Lob');

  for my $with_id (0, 1) {
    # core's _insert_bulk needs a placeholder for the key it binds
    next if $with_id and not $PLACEHOLDERS;
    for my $case (@CASES) {
      my ($what, $texts) = @$case;
      my $n = @$texts;
      my $tag = "$name, $what" . ( $with_id ? ', id given' : '' );

      my @ids  = $with_id ? (101 .. 100 + $n) : ($IDENTITY - $n + 1 .. $IDENTITY);
      my @rows = $with_id
        ? ( [qw(id c_text)], map { [ $ids[$_], $texts->[$_] ] } 0 .. $#$texts )
        : ( [qw(c_text)],    map { [ $texts->[$_] ] } 0 .. $#$texts );
      my @given = map { [ @$_ ] } @rows;

      reset_records();
      lives_ok { $rs->populate(\@rows) } "$tag: populate() lives"
        or next;