Dimedis-Sql

 view release on metacpan or  search on metacpan

dsql_test.pl  view on Meta::CPAN

	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

dsql_test.pl  view on Meta::CPAN

		},
		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 => {

dsql_test.pl  view on Meta::CPAN

		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 (

lib/Dimedis/Sql.pm  view on Meta::CPAN

	eval {
		$serial = $self->db_insert (\%par);
	};
	croak "$exc:insert\t$@" if $@;

	return $serial;	
}

# UPDATE -------------------------------------------------------------

sub update {
	my $self = shift;
	my %par = @_;
	
	$par{type}   ||= $self->{type_href}->{$par{table}}; # wenn undef, globales Type Hash holen
	$par{params} ||= [];	# wenn undef, leeres Listref draus machen
	
	# Parametercheck
	
	croak "$exc:insert\tmissing table" unless defined $par{table};
	croak "$exc:insert\tmissing data"  unless defined $par{data};