On Wed, 15 Oct 2014 21:39:47 +0200, Jens Rehsack <rehs...@gmail.com> wrote:
>
> Am 15.10.2014 um 19:16 schrieb H.Merijn Brand <h.m.br...@xs4all.nl>:
>
> >
> > my $dbh = DBI->connect ("dbi:CSV:f_dir=.");
> >
> > # do something with $dbh
> >
> > $dbh->disconnect;
> >
> > $dbh = DBI->connect ("dbi:CSV:f_dir=test");
> >
> > The second connect does NOT call data_sources () using whatever the
> > first left behind. I think that is a serious bug.
> >
> > Found that while trying to find an issue found by Mithaldu where
> >
> > $dbh = DBI->connect ("dbi:CSV:f_dir=./non_existent");
> >
> > will *always* fall back to "." (curdir), which IMHO is just as serious
> > a bug.
>
> I completely agree above analysis.
>
> > /me is digging …
>
> Thanks. Will join next week or so when finished PoC using AnyData (purely ...)
doubt: should DBD::File::connect croak or should it return undef and
set the error?
Other than that, the important fix is, which I plan to apply after we
decide to croak or return undef/errstr (of course with a not in
Changes):
--8<---
diff --git a/lib/DBD/File.pm b/lib/DBD/File.pm
index 590a351..90336b5 100644
--- a/lib/DBD/File.pm
+++ b/lib/DBD/File.pm
@@ -85,6 +85,8 @@ use warnings;
use vars qw( @ISA $imp_data_size );
+use Carp;
+
@DBD::File::dr::ISA = qw( DBI::DBD::SqlEngine::dr );
$DBD::File::dr::imp_data_size = 0;
@@ -100,6 +102,26 @@ sub dsn_quote
# XXX rewrite using TableConfig ...
sub default_table_source { "DBD::File::TableSource::FileSystem" }
+sub connect
+{
+ my ($drh, $dbname, $user, $auth, $attr) = @_;
+
+ if (my $attr_hash = (DBI->parse_dsn ($dbname))[3]) {
+ if (defined $attr_hash->{f_dir} && ! -d $attr_hash->{f_dir}) {
+ #DBI->set_err (2, "No such directory '$attr_hash->{f_dir}");
+ #croak "No such directory '$attr_hash->{f_dir}'";
+ return;
+ }
+ }
+ if ($attr and defined $attr->{f_dir} && ! -d $attr->{f_dir}) {
+ #DBI->set_err (2, "No such directory '$attr_hash->{f_dir}");
+ #croak "No such directory '$attr->{f_dir}'";
+ return;
+ }
+
+ return DBI::DBD::SqlEngine::dr::connect ($drh, $dbname, $user, $auth,
$attr);
+ } # connect
+
sub disconnect_all
{
} # disconnect_all
@@ -130,7 +152,7 @@ sub data_sources
{
my ($dbh, $attr, @other) = @_;
ref ($attr) eq "HASH" or $attr = {};
- exists $attr->{f_dir} or $attr->{f_dir} = $dbh->{f_dir};
+ exists $attr->{f_dir} or $attr->{f_dir} = $dbh->{f_dir};
exists $attr->{f_dir_search} or $attr->{f_dir_search} =
$dbh->{f_dir_search};
return $dbh->SUPER::data_sources ($attr, @other);
} # data_source
@@ -343,6 +365,10 @@ sub data_sources
? $attr->{f_dir}
: File::Spec->curdir ();
defined $dir or return; # Stream-based databases do not have f_dir
+ unless (-d $dir && -r $dir && -x $dir) {
+ $drh->set_err ($DBI::stderr, "Cannot use main directory $dir");
+ return;
+ }
my %attrs;
$attr and %attrs = %$attr;
delete $attrs{f_dir};
diff --git a/t/49dbd_file.t b/t/49dbd_file.t
index 1883bfa..60ea6cb 100644
--- a/t/49dbd_file.t
+++ b/t/49dbd_file.t
@@ -207,6 +207,16 @@ ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
ok ($dbh->do ("drop table $tbl"), "table drop");
is (-s $tbl_file, undef, "Test table removed"); # -s => size test
+# ==================== Nonexisting top-dir ========================
+foreach my $tld ("./non-existing", "nonexisting_folder",
"/Fr-dle/hurd0k/ok$$") {
+ is (DBI->connect ("dbi:File:", undef, undef, {
+ f_dir => $tld,
+
+ RaiseError => 0,
+ PrintError => 0,
+ }), undef, "Should not be able to open a DB to a non-existig folder");
+ }
+
done_testing ();
sub DBD::File::Table::fetch_row ($$)
-->8---
I did not yet find the correct way to specify DBI::errstr :(
--
H.Merijn Brand http://tux.nl Perl Monger http://amsterdam.pm.org/
using perl5.00307 .. 5.19 porting perl5 on HP-UX, AIX, and openSUSE
http://mirrors.develooper.com/hpux/ http://www.test-smoke.org/
http://qa.perl.org http://www.goldmark.org/jeff/stupid-disclaimers/
pgpS9yrrIbo4K.pgp
Description: OpenPGP digital signature
