Merge remote branch 'remotes/origin/uri_filename'

Changes

@@ -17,6 +17,7 @@ ${NEXT}
       readable/writable again by dropping partial indices.
 
     - Resolved #87435: PATCH: statistics_info perldoc (DDICK)
+    - Resolved #87297: URI filenames in DBD::SQLite (ISHIGAKI)
 
 1.40 Sun 28 Jul 2013
     - NetBSD also doesn't like the _XOPEN_SOURCE hack (ISHIGAKI)

SQLite.xs

@@ -576,6 +576,62 @@ SAVEPOINT()
     OUTPUT:
         RETVAL
 
+static int
+OPEN_READONLY()
+    CODE:
+        RETVAL = SQLITE_OPEN_READONLY;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_READWRITE()
+    CODE:
+        RETVAL = SQLITE_OPEN_READWRITE;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_CREATE()
+    CODE:
+        RETVAL = SQLITE_OPEN_CREATE;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_NOMUTEX()
+    CODE:
+        RETVAL = SQLITE_OPEN_NOMUTEX;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_FULLMUTEX()
+    CODE:
+        RETVAL = SQLITE_OPEN_FULLMUTEX;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_SHAREDCACHE()
+    CODE:
+        RETVAL = SQLITE_OPEN_SHAREDCACHE;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_PRIVATECACHE()
+    CODE:
+        RETVAL = SQLITE_OPEN_PRIVATECACHE;
+    OUTPUT:
+        RETVAL
+
+static int
+OPEN_URI()
+    CODE:
+        RETVAL = SQLITE_OPEN_URI;
+    OUTPUT:
+        RETVAL
+
 
 
 INCLUDE: SQLite.xsi

dbdimp.c

@@ -38,7 +38,8 @@ imp_dbh_t *last_executed_dbh; /* needed by perl_tokenizer
 #define sqlite_error(h,rc,what) _sqlite_error(aTHX_ __FILE__, __LINE__, h, rc, what)
 #define sqlite_trace(h,xxh,level,what) if ( DBIc_TRACE_LEVEL((imp_xxh_t*)xxh) >= level ) _sqlite_trace(aTHX_ __FILE__, __LINE__, h, (imp_xxh_t*)xxh, what)
 #define sqlite_exec(h,sql) _sqlite_exec(aTHX_ h, imp_dbh->db, sql)
-#define sqlite_open(dbname,db) _sqlite_open(aTHX_ dbh, dbname, db)
+#define sqlite_open(dbname,db) _sqlite_open(aTHX_ dbh, dbname, db, 0)
+#define sqlite_open2(dbname,db,flags) _sqlite_open(aTHX_ dbh, dbname, db, flags)
 #define _isspace(c) (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\v' || c == '\f')
 
 static void
@@ -83,10 +84,14 @@ _sqlite_exec(pTHX_ SV *h, sqlite3 *db, const char *sql)
 }
 
 int
-_sqlite_open(pTHX_ SV *dbh, const char *dbname, sqlite3 **db)
+_sqlite_open(pTHX_ SV *dbh, const char *dbname, sqlite3 **db, int flags)
 {
     int rc;
-    rc = sqlite3_open(dbname, db);
+    if (flags) {
+        rc = sqlite3_open_v2(dbname, db, flags, NULL);
+    } else {
+        rc = sqlite3_open(dbname, db);
+    }
     if ( rc != SQLITE_OK ) {
         sqlite_error(dbh, rc, sqlite3_errmsg(*db));
         if (*db) sqlite3_close(*db);
@@ -273,7 +278,11 @@ sqlite_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pa
 
     sqlite_trace(dbh, imp_dbh, 3, form("login '%s' (version %s)", dbname, sqlite3_version));
 
-    rc = sqlite_open(dbname, &(imp_dbh->db));
+    if (SvROK(attr) && hv_exists((HV*)SvRV(attr), "sqlite_open_flags", 17)) {
+        rc = sqlite_open2(dbname, &(imp_dbh->db), SvIV(*hv_fetch((HV*)SvRV(attr), "sqlite_open_flags", 17, NULL)));
+    } else {
+        rc = sqlite_open(dbname, &(imp_dbh->db));
+    }
     if ( rc != SQLITE_OK ) {
         return FALSE; /* -> undef in lib/DBD/SQLite.pm */
     }

lib/DBD/SQLite.pm

@@ -95,15 +95,24 @@ sub connect {
             my ($key, $value) = split(/=/, $attrib, 2);
             if ( $key =~ /^(?:db(?:name)?|database)$/ ) {
                 $real = $value;
+            } elsif ( $key eq 'uri' ) {
+                $real = $value;
+                $attr->{sqlite_open_flags} |= DBD::SQLite::OPEN_URI();
             } else {
                 $attr->{$key} = $value;
             }
         }
     }
 
+    if (my $flags = $attr->{sqlite_open_flags}) {
+        unless ($flags & (DBD::SQLite::OPEN_READONLY() | DBD::SQLite::OPEN_READWRITE())) {
+            $attr->{sqlite_open_flags} |= DBD::SQLite::OPEN_READWRITE() | DBD::SQLite::OPEN_CREATE();
+        }
+    }
+
     # To avoid unicode and long file name problems on Windows,
     # convert to the shortname if the file (or parent directory) exists.
-    if ( $^O =~ /MSWin32/ and $real ne ':memory:' and $real ne '') {
+    if ( $^O =~ /MSWin32/ and $real ne ':memory:' and $real ne '' and $real !~ /^file:/) {
         require Win32;
         require File::Basename;
         my ($file, $dir, $suffix) = File::Basename::fileparse($real);
@@ -985,6 +994,23 @@ If the filename C<$dbfile> is an empty string, then a private,
 temporary on-disk database will be created. This private database will
 be automatically deleted as soon as the database connection is closed.
 
+As of 1.41_01, you can pass URI filename (see L<http://www.sqlite.org/uri.html>)
+as well for finer control:
+
+  my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc");
+
+Note that this is not for remote SQLite database connection. You only can
+connect to a local database.
+
+You can also set sqlite_open_flags (only) when you connect to a database:
+
+  use DBD::SQLite;
+  my $dbh = DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+    sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
+  });
+
+See L<http://www.sqlite.org/c3ref/open.html> for details.
+
 =head2 DBD::SQLite And File::Temp
 
 When you use L<File::Temp> to create a temporary file/directory for
@@ -2609,10 +2635,6 @@ code we work with leaks.
 
 Reading/writing into blobs using C<sqlite2_blob_open> / C<sqlite2_blob_close>.
 
-=head2 Flags for sqlite3_open_v2
-
-Support the full API of sqlite3_open_v2 (flags for opening the file).
-
 =head2 Support for custom callbacks for R-Tree queries
 
 Custom queries of a R-Tree index using a callback are possible with

t/56_open_flags.t

@@ -0,0 +1,107 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test;
+use Test::More tests => 8;
+use DBI;
+use DBD::SQLite;
+
+my $dbfile = 'foo';
+unlink $dbfile if -f $dbfile;
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile, "failed to open a nonexistent dbfile for readonly";
+  unlink $dbfile if -f $dbfile;
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile, "failed to open a nonexistent dbfile for readwrite (without create)";
+  unlink $dbfile if -f $dbfile;
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE|DBD::SQLite::OPEN_CREATE,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile, "created a dbfile for readwrite";
+  $dbh->disconnect;
+  unlink $dbfile if -f $dbfile;
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile, "readwrite/create flags are turned on if no readonly/readwrite/create flags are set";
+  $dbh->disconnect;
+  unlink $dbfile if -f $dbfile;
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
+    });
+  };
+  ok !$@ && $dbh, "opened an existing dbfile for readonly";
+  $dbh->disconnect;
+  unlink $dbfile if -f $dbfile;
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE,
+    });
+  };
+  ok !$@ && $dbh, "opened an existing dbfile for readwrite";
+  $dbh->disconnect;
+  unlink $dbfile if -f $dbfile;
+}

t/57_uri_filename.t

@@ -0,0 +1,222 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test;
+use Test::More tests => 17;
+use DBI;
+use DBD::SQLite;
+
+my $dbfile = 'foo';
+my %uri = (
+  base => 'file:foo',
+  ro   => 'file:foo?mode=ro',
+  rw   => 'file:foo?mode=rw',
+  rwc  => 'file:foo?mode=rwc',
+);
+
+sub cleanup {
+  unlink $dbfile if -f $dbfile;
+  unlink "file" if -f "file"; # for Win32
+  for (keys %uri) {
+    unlink $uri{$_} if -f $uri{$_};
+  }
+}
+
+cleanup();
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{base}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && $dbh && !-f $dbfile, "correct database is not created for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+# uri=(uri)
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{base}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base}, "correct database is created for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{ro}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile && !-f $uri{base} && !-f $uri{ro}, "failed to open a nonexistent readonly database for uri";
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{rw}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile && !-f $uri{base} && !-f $uri{rw}, "failed to open a nonexistent readwrite database for uri";
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{rwc}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{rwc}, "correct database is created for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{ro}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{ro}, "opened a correct readonly database for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:uri=$uri{rw}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{rw}, "opened a correct readwrite database for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+# OPEN_URI flag
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{base}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base}, "correct database is created for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{ro}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile && !-f $uri{base} && !-f $uri{ro}, "failed to open a nonexistent readonly database for uri";
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{rw}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok $@ && !$dbh && !-f $dbfile && !-f $uri{base} && !-f $uri{rw}, "failed to open a nonexistent readwrite database for uri";
+  cleanup();
+}
+
+{
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{rwc}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{rwc}, "correct database is created for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{ro}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{ro}, "opened a correct readonly database for uri";
+  $dbh->disconnect;
+  cleanup();
+}
+
+{
+  eval {
+    DBI->connect("dbi:SQLite:$dbfile", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+    });
+  };
+  ok !$@ && -f $dbfile, "created a dbfile";
+
+  my $dbh = eval {
+    DBI->connect("dbi:SQLite:$uri{rw}", undef, undef, {
+      PrintError => 0,
+      RaiseError => 1,
+      sqlite_open_flags => DBD::SQLite::OPEN_URI,
+    });
+  };
+  ok !$@ && $dbh && -f $dbfile && !-f $uri{base} && !-f $uri{rw}, "opened a correct readwrite database for uri";
+  $dbh->disconnect;
+  cleanup();
+}