mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
- Adding support parsing attributes out of the DSN (ADAMK)
- Dropping support for uncode before 5.8.5 to simplify support and
to prevent people hurting themselves on platforms that don't
properly support Unicode anyway (ADAMK)
This commit is contained in:
Adam Kennedy
parent
00d9d67496
commit
09f58b864d
8 changed files with 222 additions and 171 deletions
30
Changes
30
Changes
|
|
@ -1,25 +1,29 @@
|
|||
Changes for Perl extension DBD-SQLite.
|
||||
|
||||
1.22_04 not yet released
|
||||
- Inserted pTHX_/aTHX_ for better efficiency (suggested in #44884 by TIMB) (ISHIGAKI)
|
||||
- Adding support parsing attributes out of the DSN (ADAMK)
|
||||
- Inserted pTHX_/aTHX_ for better efficiency (suggested in #44884 by TIMB) (ISHIGAKI)
|
||||
- Dropping support for uncode before 5.8.5 to simplify support and
|
||||
to prevent people hurting themselves on platforms that don't
|
||||
properly support Unicode anyway (ADAMK)
|
||||
|
||||
1.22_03 Thu 10 Apr 2009
|
||||
- Resolved #44876: Patch to fix includes in the SQLITE_LOCATION case by janus (ISHIGAKI)
|
||||
- Added PERL_NO_GET_CONTEXT for efficiency (suggested in #44884 by TIMB) (ISHIGAKI)
|
||||
- Refactored error handling (suggested in #44884, #44871 by TIMB) (ISHIGAKI)
|
||||
- Resolved #44876: Patch to fix includes in the SQLITE_LOCATION case by janus (ISHIGAKI)
|
||||
- Added PERL_NO_GET_CONTEXT for efficiency (suggested in #44884 by TIMB) (ISHIGAKI)
|
||||
- Refactored error handling (suggested in #44884, #44871 by TIMB) (ISHIGAKI)
|
||||
|
||||
1.22_02 Wed 9 Apr 2009
|
||||
- Added missing documentation bits for 'create_collation'
|
||||
and 'progress_handler' (DAMI)
|
||||
- Resolved RT#25924 (Arguments to user-defined functions do not
|
||||
respect unicode setting) (DAMI)
|
||||
- Added comments on the return values on error, and fixed another
|
||||
wrong return value in execute (ISHIGAKI)
|
||||
- Added SQL_NULLABLE_UNKNOWN; still wonders if the error above
|
||||
should be ignored or not (ISHIGAKI)
|
||||
- Added missing documentation bits for 'create_collation'
|
||||
and 'progress_handler' (DAMI)
|
||||
- Resolved RT#25924 (Arguments to user-defined functions do not
|
||||
respect unicode setting) (DAMI)
|
||||
- Added comments on the return values on error, and fixed another
|
||||
wrong return value in execute (ISHIGAKI)
|
||||
- Added SQL_NULLABLE_UNKNOWN; still wonders if the error above
|
||||
should be ignored or not (ISHIGAKI)
|
||||
|
||||
1.22_01 Wed 9 Apr 2009
|
||||
- Resolved #25371: Calls sv_utf8_upgrade on strings going into
|
||||
- Resolved #25371: Calls sv_utf8_upgrade on strings going into
|
||||
the database to make sure latin-1 strings are not saved as
|
||||
Malformed UTF-8 character in the SQLite TEXT column (MIYAGAWA)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
use 5.006; #from ExtUtils::MakeMaker 6.48 and DBI 1.43
|
||||
# From ExtUtils::MakeMaker 6.48 and DBI 1.43
|
||||
use 5.006;
|
||||
use strict;
|
||||
use ExtUtils::MakeMaker;
|
||||
use Config;
|
||||
|
|
@ -140,7 +141,6 @@ if ( 0 ) {
|
|||
|
||||
# Use always the bundled one.
|
||||
# XXX: ... and this message should be more informative.
|
||||
|
||||
$force_local = 1;
|
||||
print "We're using the bundled sqlite library.\n" if $ENV{AUTOMATED_TESTING};
|
||||
|
||||
|
|
|
|||
|
|
@ -23,11 +23,11 @@ sub driver {
|
|||
|
||||
$class .= "::dr";
|
||||
|
||||
$drh = DBI::_new_drh($class, {
|
||||
$drh = DBI::_new_drh( $class, {
|
||||
Name => 'SQLite',
|
||||
Version => $VERSION,
|
||||
Attribution => 'DBD::SQLite by Matt Sergeant et al',
|
||||
});
|
||||
} );
|
||||
|
||||
return $drh;
|
||||
}
|
||||
|
|
@ -53,18 +53,18 @@ sub connect {
|
|||
my $real = $dbname;
|
||||
if ( $dbname =~ /=/ ) {
|
||||
foreach my $attrib ( split(/;/, $dbname ) ) {
|
||||
my ($k, $v) = split(/=/, $attrib, 2);
|
||||
if ($k eq 'dbname') {
|
||||
$real = $v;
|
||||
my ($key, $value) = split(/=/, $attrib, 2);
|
||||
if ( $key eq 'dbname' ) {
|
||||
$real = $value;
|
||||
} else {
|
||||
# TODO: add to attribs
|
||||
$attr->{$key} = $value;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
DBD::SQLite::db::_login($dbh, $real, $user, $auth) or return undef;
|
||||
|
||||
# install perl collations
|
||||
# Install perl collations
|
||||
my $perl_collation = sub { $_[0] cmp $_[1] };
|
||||
my $perl_locale_collation = sub { use locale; $_[0] cmp $_[1] };
|
||||
$dbh->func( "perl", $perl_collation, "create_collation" );
|
||||
|
|
@ -373,7 +373,7 @@ __END__
|
|||
|
||||
=head1 NAME
|
||||
|
||||
DBD::SQLite - Self Contained RDBMS in a DBI Driver
|
||||
DBD::SQLite - Self-contained RDBMS in a DBI Driver
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -386,8 +386,8 @@ SQLite is a public domain RDBMS database engine that you can find
|
|||
at L<http://www.hwaci.com/sw/sqlite/>.
|
||||
|
||||
Rather than ask you to install SQLite first, because SQLite is public
|
||||
domain, DBD::SQLite includes the entire thing in the distribution. So
|
||||
in order to get a fast transaction capable RDBMS working for your
|
||||
domain, B<DBD::SQLite> includes the entire thing in the distribution.
|
||||
So in order to get a fast transaction capable RDBMS working for your
|
||||
perl project you simply have to install this module, and B<nothing>
|
||||
else.
|
||||
|
||||
|
|
@ -402,11 +402,11 @@ See L<http://www.hwaci.com/sw/sqlite/lang.html> for details.
|
|||
=item A complete DB in a single disk file
|
||||
|
||||
Everything for your database is stored in a single disk file, making it
|
||||
easier to move things around than with DBD::CSV.
|
||||
easier to move things around than with L<DBD::CSV>.
|
||||
|
||||
=item Atomic commit and rollback
|
||||
|
||||
Yes, DBD::SQLite is small and light, but it supports full transactions!
|
||||
Yes, B<DBD::SQLite> is small and light, but it supports full transactions!
|
||||
|
||||
=item Extensible
|
||||
|
||||
|
|
@ -435,12 +435,12 @@ limited by the typeless nature of the SQLite database.
|
|||
|
||||
=item sqlite_version
|
||||
|
||||
Returns the version of the SQLite library which DBD::SQLite is using,
|
||||
Returns the version of the SQLite library which B<DBD::SQLite> is using,
|
||||
e.g., "2.8.0". Can only be read.
|
||||
|
||||
=item unicode
|
||||
|
||||
If set to a true value, DBD::SQLite will turn the UTF-8 flag on for all text
|
||||
If set to a true value, B<DBD::SQLite> will turn the UTF-8 flag on for all text
|
||||
strings coming out of the database. For more details on the UTF-8 flag see
|
||||
L<perlunicode>. The default is for the UTF-8 flag to be turned off.
|
||||
|
||||
|
|
@ -470,7 +470,7 @@ This method returns the last inserted rowid. If you specify an INTEGER PRIMARY
|
|||
KEY as the first column in your table, that is the column that is returned.
|
||||
Otherwise, it is the hidden ROWID column. See the sqlite docs for details.
|
||||
|
||||
Note: You can now use $dbh->last_insert_id() if you have a recent version of
|
||||
Note: You can now use $dbh-E<gt>last_insert_id() if you have a recent version of
|
||||
DBI.
|
||||
|
||||
=head2 $dbh->func('busy_timeout')
|
||||
|
|
@ -534,13 +534,15 @@ The driver will check that this is a proper sorting function.
|
|||
|
||||
Collations C<binary> and C<nocase> are builtin within Sqlite.
|
||||
Collations C<perl> and C<perllocale> are builtin within
|
||||
the C<DBD::SQLite> driver, and correspond to the
|
||||
the B<DBD::SQLite> driver, and correspond to the
|
||||
Perl C<cmp> operator with or without the L<locale> pragma;
|
||||
so you can write for example
|
||||
|
||||
CREATE TABLE foo(txt1 COLLATE perl,
|
||||
txt2 COLLATE perllocale,
|
||||
txt3 COLLATE nocase)
|
||||
CREATE TABLE foo(
|
||||
txt1 COLLATE perl,
|
||||
txt2 COLLATE perllocale,
|
||||
txt3 COLLATE nocase
|
||||
)
|
||||
|
||||
or
|
||||
|
||||
|
|
@ -553,11 +555,13 @@ C<unicode> attribute is set B<before> the call to
|
|||
C<create_collation>. The recommended way to activate unicode
|
||||
is to set the parameter at connection time :
|
||||
|
||||
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "",
|
||||
{ RaiseError => 1,
|
||||
unicode => 1} );
|
||||
|
||||
|
||||
my $dbh = DBI->connect(
|
||||
"dbi:SQLite:dbname=foo", "", "",
|
||||
{
|
||||
RaiseError => 1,
|
||||
unicode => 1,
|
||||
}
|
||||
);
|
||||
|
||||
=head2 $dbh->func( $name, $argc, $pkg, 'create_aggregate' )
|
||||
|
||||
|
|
@ -716,7 +720,7 @@ the DBI module. Just type:
|
|||
On the command line to access the file F<foo.db>.
|
||||
|
||||
Alternatively you can install SQLite from the link above without conflicting
|
||||
with DBD::SQLite and use the supplied C<sqlite> command line tool.
|
||||
with B<DBD::SQLite> and use the supplied C<sqlite> command line tool.
|
||||
|
||||
=head1 PERFORMANCE
|
||||
|
||||
|
|
|
|||
30
t/02_logon.t
30
t/02_logon.t
|
|
@ -8,13 +8,27 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 6;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 9;
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||
diag("sqlite_version=$dbh->{sqlite_version}");
|
||||
ok( $dbh->func('busy_timeout'), 'Found initial busy_timeout' );
|
||||
ok( $dbh->func(5000, 'busy_timeout') );
|
||||
is( $dbh->func('busy_timeout'), 5000, 'Set busy_timeout to new value' );
|
||||
# Ordinary connect
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||
diag("sqlite_version=$dbh->{sqlite_version}");
|
||||
ok( $dbh->func('busy_timeout'), 'Found initial busy_timeout' );
|
||||
ok( $dbh->func(5000, 'busy_timeout') );
|
||||
is( $dbh->func('busy_timeout'), 5000, 'Set busy_timeout to new value' );
|
||||
}
|
||||
|
||||
# Attributes in the connect string
|
||||
SKIP: {
|
||||
unless ( $] >= 5.008005 ) {
|
||||
skip( 'Unicode is not supported before 5.8.5', 2 );
|
||||
}
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=foo;unicode=1', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
}
|
||||
|
|
|
|||
128
t/12_unicode.t
128
t/12_unicode.t
|
|
@ -10,88 +10,112 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 16;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 19 );
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
use Test::NoWarnings;
|
||||
|
||||
#
|
||||
# Include std stuff
|
||||
#
|
||||
|
||||
use Carp;
|
||||
use DBI qw(:sql_types);
|
||||
|
||||
no bytes; # Unintuitively, still has the effect of loading bytes.pm :-)
|
||||
# Unintuitively, still has the effect of loading bytes.pm :-)
|
||||
no bytes;
|
||||
|
||||
# Portable albeit kludgy: detects UTF-8 promotion of $hibyte from
|
||||
# the abnormal length increase of $string concatenated to it.
|
||||
sub is_utf8 {
|
||||
no bytes;
|
||||
my ($string) = @_;
|
||||
my $hibyte = pack("C", 0xe9);
|
||||
my @lengths = map { bytes::length($_) } ($string, $string . $hibyte);
|
||||
return ($lengths[0] + 1 < $lengths[1]);
|
||||
no bytes;
|
||||
my ($string) = @_;
|
||||
my $hibyte = pack("C", 0xe9);
|
||||
my @lengths = map { bytes::length($_) } ($string, $string . $hibyte);
|
||||
return ($lengths[0] + 1 < $lengths[1]);
|
||||
}
|
||||
|
||||
# First, some UTF-8 framework self-test:
|
||||
|
||||
my @isochars = (ord("K"), 0xf6, ord("n"), ord("i"), ord("g"));
|
||||
my $bytestring = pack("C*", @isochars);
|
||||
my $utfstring = pack("U*", @isochars);
|
||||
|
||||
ok(length($bytestring) == @isochars, 'Correct length for $bytestring');
|
||||
ok(length($utfstring) == @isochars, 'Correct length for $utfstring');
|
||||
ok(is_utf8($utfstring),
|
||||
'$utfstring should be marked as UTF-8 by Perl');
|
||||
ok(! is_utf8($bytestring),
|
||||
'$bytestring should *NOT* be marked as UTF-8 by Perl');
|
||||
|
||||
### Real DBD::SQLite testing starts here
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
|
||||
ok(
|
||||
$dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)"),
|
||||
'CREATE TABLE',
|
||||
is_utf8($utfstring),
|
||||
'$utfstring should be marked as UTF-8 by Perl',
|
||||
);
|
||||
ok(
|
||||
! is_utf8($bytestring),
|
||||
'$bytestring should *NOT* be marked as UTF-8 by Perl',
|
||||
);
|
||||
|
||||
# Sends $ain and $bin into TEXT resp. BLOB columns the database, then
|
||||
# reads them again and returns the result as a list ($aout, $bout).
|
||||
sub database_roundtrip {
|
||||
my ($ain, $bin) = @_;
|
||||
$dbh->do("DELETE FROM table1");
|
||||
my $sth = $dbh->prepare("INSERT INTO table1 (a, b) VALUES (?, ?)");
|
||||
$sth->bind_param(1, $ain, SQL_VARCHAR);
|
||||
$sth->bind_param(2, $bin, SQL_BLOB);
|
||||
$sth->execute();
|
||||
$sth = $dbh->prepare("SELECT a, b FROM table1");
|
||||
$sth->execute();
|
||||
my @row = $sth->fetchrow_array;
|
||||
undef $sth;
|
||||
croak "Bad row length ".@row unless (@row == 2);
|
||||
@row;
|
||||
### Real DBD::SQLite testing starts here
|
||||
my ($textback, $bytesback);
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
is( $dbh->{unicode}, 0, 'Unicode is off' );
|
||||
ok(
|
||||
$dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)"),
|
||||
'CREATE TABLE',
|
||||
);
|
||||
|
||||
($textback, $bytesback) = database_roundtrip($dbh, $bytestring, $bytestring);
|
||||
|
||||
ok(
|
||||
! is_utf8($bytesback),
|
||||
"Reading blob gives binary",
|
||||
);
|
||||
ok(
|
||||
! is_utf8($textback),
|
||||
"Reading text gives binary too (for now)",
|
||||
);
|
||||
is($bytesback, $bytestring, "No blob corruption");
|
||||
is($textback, $bytestring, "Same text, different encoding");
|
||||
}
|
||||
|
||||
my ($textback, $bytesback) = database_roundtrip($bytestring, $bytestring);
|
||||
|
||||
ok(! is_utf8($bytesback), "Reading blob gives binary");
|
||||
ok(! is_utf8($textback), "Reading text gives binary too (for now)");
|
||||
ok($bytesback eq $bytestring, "No blob corruption");
|
||||
ok($textback eq $bytestring, "Same text, different encoding");
|
||||
|
||||
# Start over but now activate Unicode support.
|
||||
$dbh->{unicode} = 1;
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
|
||||
($textback, $bytesback) = database_roundtrip($utfstring, $bytestring);
|
||||
($textback, $bytesback) = database_roundtrip($dbh, $utfstring, $bytestring);
|
||||
|
||||
ok(! is_utf8($bytesback), "Reading blob still gives binary");
|
||||
ok(is_utf8($textback), "Reading text returns UTF-8");
|
||||
ok($bytesback eq $bytestring, "Still no blob corruption");
|
||||
ok($textback eq $utfstring, "Same text");
|
||||
ok(! is_utf8($bytesback), "Reading blob still gives binary");
|
||||
ok(is_utf8($textback), "Reading text returns UTF-8");
|
||||
ok($bytesback eq $bytestring, "Still no blob corruption");
|
||||
ok($textback eq $utfstring, "Same text");
|
||||
|
||||
my $lengths = $dbh->selectall_arrayref(
|
||||
"SELECT length(a), length(b) FROM table1"
|
||||
);
|
||||
my $lengths = $dbh->selectall_arrayref(
|
||||
"SELECT length(a), length(b) FROM table1"
|
||||
);
|
||||
|
||||
ok($lengths->[0]->[0] == $lengths->[0]->[1],
|
||||
"Database actually understands char set") or
|
||||
warn "($lengths->[0]->[0] != $lengths->[0]->[1])";
|
||||
ok(
|
||||
$lengths->[0]->[0] == $lengths->[0]->[1],
|
||||
"Database actually understands char set"
|
||||
)
|
||||
or
|
||||
warn "($lengths->[0]->[0] != $lengths->[0]->[1])";
|
||||
}
|
||||
|
||||
sub database_roundtrip {
|
||||
my ($dbh, $ain, $bin) = @_;
|
||||
$dbh->do("DELETE FROM table1");
|
||||
my $sth = $dbh->prepare("INSERT INTO table1 (a, b) VALUES (?, ?)");
|
||||
$sth->bind_param(1, $ain, SQL_VARCHAR);
|
||||
$sth->bind_param(2, $bin, SQL_BLOB );
|
||||
$sth->execute();
|
||||
$sth = $dbh->prepare("SELECT a, b FROM table1");
|
||||
$sth->execute();
|
||||
my @row = $sth->fetchrow_array;
|
||||
undef $sth;
|
||||
croak "Bad row length ".@row unless (@row == 2);
|
||||
@row;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,27 +6,26 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008 ) {
|
||||
plan( tests => 8 );
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 9 );
|
||||
} else {
|
||||
plan( skip_all => 'Need Perl 5.8 or later' );
|
||||
exit(0);
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::NoWarnings;
|
||||
use Encode qw/decode/;
|
||||
|
||||
BEGIN {
|
||||
# Sadly perl for windows (and probably sqlite, too) may hang
|
||||
# if the system locale doesn't support european languages.
|
||||
# en-us should be a safe default. if it doesn't work, use 'C'.
|
||||
if ($^O eq 'MSWin32') {
|
||||
use POSIX 'locale_h';
|
||||
setlocale(LC_COLLATE, 'en-us');
|
||||
}
|
||||
# Sadly perl for windows (and probably sqlite, too) may hang
|
||||
# if the system locale doesn't support european languages.
|
||||
# en-us should be a safe default. if it doesn't work, use 'C'.
|
||||
if ( $^O eq 'MSWin32') {
|
||||
use POSIX 'locale_h';
|
||||
setlocale(LC_COLLATE, 'en-us');
|
||||
}
|
||||
}
|
||||
|
||||
my @words = qw{
|
||||
|
|
@ -48,12 +47,10 @@ my $db_sorted;
|
|||
my $sql = "SELECT txt from collate_test ORDER BY txt";
|
||||
|
||||
sub no_accents ($$) {
|
||||
my ( $a, $b ) = map lc, @_;
|
||||
|
||||
tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý]
|
||||
[aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b;
|
||||
|
||||
$a cmp $b;
|
||||
my ( $a, $b ) = map lc, @_;
|
||||
tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý]
|
||||
[aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b;
|
||||
$a cmp $b;
|
||||
}
|
||||
|
||||
$dbh = connect_ok( RaiseError => 1 );
|
||||
|
|
|
|||
|
|
@ -7,25 +7,32 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 22;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 23 );
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $dbh = connect_ok();
|
||||
$dbh->{unicode} = 1;
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE foo (
|
||||
bar varchar(255)
|
||||
bar varchar(255)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
foreach ( "\0", "A", "\xe9", "\x{20ac}" ) {
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $_), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT bar FROM foo");
|
||||
is_deeply( $foo, [ [ $_ ] ], 'Value round-tripped ok' );
|
||||
my $len = $dbh->selectall_arrayref("SELECT length(bar) FROM foo");
|
||||
is $len->[0][0], 1 unless $_ eq "\0";
|
||||
my $match = $dbh->selectall_arrayref("SELECT bar FROM foo WHERE bar = ?", {}, $_);
|
||||
is $match->[0][0], $_;
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $_), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT bar FROM foo");
|
||||
is_deeply( $foo, [ [ $_ ] ], 'Value round-tripped ok' );
|
||||
my $len = $dbh->selectall_arrayref("SELECT length(bar) FROM foo");
|
||||
is $len->[0][0], 1 unless $_ eq "\0";
|
||||
my $match = $dbh->selectall_arrayref("SELECT bar FROM foo WHERE bar = ?", {}, $_);
|
||||
is $match->[0][0], $_;
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,40 +1,41 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 14;
|
||||
use t::lib::Test;
|
||||
|
||||
my $dbh = connect_ok();
|
||||
$dbh->{unicode} = 1;
|
||||
|
||||
$dbh->func( "perl_uc", 1, \&perl_uc, "create_function" );
|
||||
|
||||
|
||||
my @words = qw{Bergère hôte hétaïre hêtre};
|
||||
|
||||
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE foo (
|
||||
bar varchar(255)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
foreach my $word (@words) {
|
||||
utf8::upgrade($word);
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $word), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT perl_uc(bar) FROM foo");
|
||||
is_deeply( $foo, [ [ perl_uc($word) ] ], 'unicode upcase ok' );
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub perl_uc {
|
||||
my $string = shift;
|
||||
return uc($string);
|
||||
}
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 14 );
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
require utf8;
|
||||
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
$dbh->func( "perl_uc", 1, \&perl_uc, "create_function" );
|
||||
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE foo (
|
||||
bar varchar(255)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
my @words = qw{Bergère hôte hétaïre hêtre};
|
||||
foreach my $word (@words) {
|
||||
utf8::upgrade($word);
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $word), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT perl_uc(bar) FROM foo");
|
||||
is_deeply( $foo, [ [ perl_uc($word) ] ], 'unicode upcase ok' );
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
}
|
||||
|
||||
sub perl_uc {
|
||||
my $string = shift;
|
||||
return uc($string);
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue