view release on metacpan or  search on metacpan

dsql_test.pl  view on Meta::CPAN

	return $self->insert_update_check (
		data => {
			id => undef,
			clob_data => \$memory_blob
		},
		what => 'insert',
	);
}

sub insert_file_blob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	return $self->insert_update_check (
		data => {
			id => undef,
			clob_data => "/etc/group",
		},
		what => 'insert',
	);
}

sub insert_utf8_latin_clob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
        my $data = do { use utf8; "Jörn Reder, ÄÜÖß\n" };
	my $memory_blob = $data x 10;

	return $self->insert_update_check (
		data => {
			id        => undef,
			clob_data => \$memory_blob,
                        str_short => "utf8_latin_clob",
		},
		what => 'insert',
	);
}

sub delete_file_blob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	my $sqlh = $self->{sqlh};
	
	my $delete_id_key = $self->{"id_Dimedis::Sql::Test::insert_file_blob"};

	my $cnt = $sqlh->do (
		sql    => "delete from dsql_test where id=?",
		params => [ $delete_id_key ],
	);

	return $cnt == 1;
}


sub update {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	return $self->insert_update_check (
		data => {
			nr1		=> 1,
			nr2		=> 2,
			str_short	=> " updated test string",
		},
		what => 'update',
	);
}

sub update_utf8_latin {
        my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

        my $data      = do { use utf8; "ABC Jörn Reder, ÄÜÖß" };
        my $str_short = do { use utf8; "Jörn Reder, ÄÜÖß" };
        
	return $self->insert_update_check (
		data => {
                    str_short	=> $data,
                    str_long	=> $data,
		},
                where   => "str_short = ?",
                params  => [ $str_short ],
		what    => 'update',
	);
}

sub update_memory_clob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	my $memory_blob = "das äüöÄÜÖß ist ein anderer super CLOB\n" x 10;

	return $self->insert_update_check (
		data => {
			clob_data => \$memory_blob
		},
		what => 'update',
	);
}

sub update_file_clob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	return $self->insert_update_check (
		data => {
			clob_data => "/etc/passwd",
		},
		what => 'update',
	);
}

sub update_memory_blob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	my $memory_blob = "das äüöÄÜÖß ist ein anderer ".chr(250)." super BLOB\n" x 10;

	return $self->insert_update_check (
		data => {
			clob_data => \$memory_blob
		},
		what => 'update',
	);
}

sub update_file_blob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	return $self->insert_update_check (
		data => {
			clob_data => "/etc/fstab",
		},
		what => 'update',
	);
}

sub update_utf8_latin_clob {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
        my $data = do { use utf8; "Jörn Reder, ÄÜÖß\n" };
	my $memory_blob = $data x 10;

	return $self->insert_update_check (
		data => {
                    clob_data => \$memory_blob
		},
		what => 'update',
                where  => "str_short = ?",
                params => [ "utf8_latin_clob" ],
	);
}

sub cmpi {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;
	
	my $id = $sqlh->insert (
		table => "dsql_test",
		data => {
			id => undef,
			test_case => "cmpi",
			str_short => "BRA bra",
		}
	);
	
	my $cond = $sqlh->cmpi (
		col => "str_short",
		val => "bra bra",
		op  => "=",
	);
	
	my ($read_id) = $sqlh->get (
		sql => "select id
			from   dsql_test
			where  $cond",
	);

	return $read_id == $id;
}

sub contains {
	my $self = shift;
	my $sqlh = $self->{sqlh};

	return if not $sqlh->get_features->{contains};

	$self->msg;
	
	my $id = $sqlh->insert (
		table => "dsql_test",
		data => {
			id        => undef,
			test_case => "contains",
			str_short => "BRA contains foo schnackel baz",

dsql_test.pl  view on Meta::CPAN

			str_short => 'Ä3',
		},
		what => 'insert',
	);
	
	unlink $file;
	
	return $rc;
}

sub insert_clob_file_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $clob = "Das ist ein Text mit Umläuten: ÄÖÜ äöü ß\n" x 10; # kein utf8 flag

	my $file = $self->mem_to_file ( mem => \$clob, utf8 => 1 );

	my $rc = $self->insert_update_check (
		data => {
			id => undef,
			clob_data => $file,
			str_short => 'Ä4',
		},
		what => 'insert',
	);
	
	unlink $file;
	
	return $rc;
}

sub insert_clob_fh_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $clob = "Das ist ein Text mit Umläuten: ÄÖÜ äöü ß\n" x 10; # kein utf8 flag

	my $file = $self->mem_to_file ( mem => \$clob, utf8 => 1 );

	my $fh = FileHandle->new;
	open($fh, $file) or die "can't read $file";

	my $rc = $self->insert_update_check (
		data => {
			id => undef,
			clob_data => $fh,
			str_short => 'Ä4',
		},
		what => 'insert',
	);

	close $fh;
	unlink $file;
	
	return $rc;
}

sub update_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	return $self->insert_update_check (
		data => {
			nr1		=> 44,
			nr2		=> 45,
			str_short	=> "utf8 stuff: äüöÄÜÖß \x{263a}", # mit utf8-flag
			str_short2	=> "utf8 stuff: äüöÄÜÖß",	   # ohne utf8-flag
		},
		what   => 'update',
		where  => "str_short = ?",
		params => [ "utf8 stuff: äüöÄÜÖß \x{263a}" ],
		
	);
}

sub update_blob_mem_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $blob = "Das sind neue Binärdaten: ÄÖÜ äöü ß\n" x 3; # kein utf8 flag

	my $rc = $self->insert_update_check (
		data => {
			blob_data => \$blob,
		},
		what   => 'update',
		where  => "str_short = ?",
		params => [ "Ä1" ],
	);
	
	return $rc;
}

sub update_clob_mem_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	# mit utf8-flag
	my $clob = "Das ist ein ßßß anderer Text mit Umläuten: \x{263a} ÄÖÜ äöü ß\n" x 10;

	return $self->insert_update_check (
		data => {
			clob_data => \$clob,
		},
		what   => 'update',
		where  => "str_short = ?",
		params => [ "Ä2" ],
	);
}

sub update_blob_file_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $blob = "Das sind neue Binärdaten: ÄÖÜ äöü ß\n" x 3; # kein utf8 flag

	my $file = $self->mem_to_file ( mem => \$blob, utf8 => 0 );

	my $rc = $self->insert_update_check (
		data => {
			blob_data => $file,
		},
		what   => 'update',
		where  => "str_short = ?",
		params => [ "Ä3" ],
	);
	
	unlink $file;
	
	return $rc;
}

sub update_clob_file_utf8 {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	# mit utf8-flag
	my $clob = "Das ist ein ßßß anderer Text mit Umläuten: \x{263a} ÄÖÜ äöü ß\n" x 10;

	my $file = $self->mem_to_file ( mem => \$clob, utf8 => 1 );

	my $rc = $self->insert_update_check (
		data => {
			clob_data => $file,
		},
		what   => 'update',
		where  => "str_short = ?",
		params => [ "Ä4" ],
	);
	
	unlink $file;
	
	return $rc;
}

sub get_utf8_array {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $str_short   = "utf8 stuff: äüöÄÜÖß \x{263a}";
	my $str_short2	= "utf8 stuff: äüöÄÜÖß";

	my @array = $sqlh->get (
		sql    => "select str_short, str_short2
			   from   dsql_test
			   where  str_short = ? and str_short2 = ?",
		params => [ $str_short, $str_short2 ],
	);

	return $array[0] eq $str_short and $array[1] eq $str_short2;
}

sub get_utf8_hash {
	my $self = shift;
	my $sqlh = $self->{sqlh};
	$self->msg;

	my $str_short   = "utf8 stuff: äüöÄÜÖß \x{263a}";
	my $str_short2	= "utf8 stuff: äüöÄÜÖß";

	my $href = $sqlh->get (
		sql    => "select str_short, str_short2
			   from   dsql_test
			   where  str_short = ? and str_short2 = ?",
		params => [ $str_short, $str_short2 ],
	);

	return $href->{str_short} eq $str_short and $href->{str_short2} eq $str_short2;
	return 1;
}