view release on metacpan or  search on metacpan

lib/DBD/File.pm  view on Meta::CPAN

	: 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 directory $dir from f_dir");
	return;
	}
    my %attrs;
    $attr and %attrs = %$attr;
    delete $attrs{f_dir};
    my $dsn_quote = $drh->{ImplementorClass}->can ("dsn_quote");
    my $dsnextra = join ";", map { $_ . "=" . &{$dsn_quote} ($attrs{$_}) } keys %attrs;
    my @dir = ($dir);
    $attr->{f_dir_search} && ref $attr->{f_dir_search} eq "ARRAY" and
	push @dir, grep { -d $_ } @{$attr->{f_dir_search}};
    my @dsns;
    foreach $dir (@dir) {
	my $dirh = IO::Dir->new ($dir);
	unless (defined $dirh) {
	    $drh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
	    return;
	    }

	my ($file, %names, $driver);
	$driver = $drh->{ImplementorClass} =~ m/^dbd\:\:([^\:]+)\:\:/i ? $1 : "File";

	while (defined ($file = $dirh->read ())) {
	    my $d = File::Spec->catdir ($dir, $file);
	    # allow current dir ... it can be a data_source too
	    $file ne File::Spec->updir () && -d $d and
		push @dsns, "DBI:$driver:f_dir=" . &{$dsn_quote} ($d) . ($dsnextra ? ";$dsnextra" : "");
	    }
	}
    return @dsns;
    } # data_sources

sub avail_tables {
    my ($self, $dbh) = @_;

    my $dir = $dbh->{f_dir};
    defined $dir or return;	# Stream based db's cannot be queried for tables

    my %seen;
    my @tables;
    my @dir = ($dir);
    $dbh->{f_dir_search} && ref $dbh->{f_dir_search} eq "ARRAY" and
	push @dir, grep { -d $_ } @{$dbh->{f_dir_search}};
    foreach $dir (@dir) {
	my $dirh = IO::Dir->new ($dir);

	unless (defined $dirh) {
	    $dbh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
	    return;
	    }

	my $class = $dbh->FETCH ("ImplementorClass");
	$class =~ s/::db$/::Table/;
	my ($file, %names);
	my $schema = exists $dbh->{f_schema}
	    ? defined $dbh->{f_schema} && $dbh->{f_schema} ne ""
		? $dbh->{f_schema} : undef
	    : eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent
	while (defined ($file = $dirh->read ())) {
	    my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX
	    # $tbl && $meta && -f $meta->{f_fqfn} or next;
	    $seen{defined $schema ? $schema : "\0"}{$dir}{$tbl}++ or
		push @tables, [ undef, $schema, $tbl, "TABLE", "FILE" ];
	    }
	$dirh->close () or
	    $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!");
	}

    return @tables;
    } # avail_tables

# ====== DataSource ============================================================

package DBD::File::DataSource::Stream;

use strict;
use warnings;

use Carp;

our @ISA = "DBI::DBD::SqlEngine::DataSource";

# We may have a working flock () built-in but that doesn't mean that locking
# will work on NFS (flock () may hang hard)
my $locking = eval {
    my $fh;
    my $nulldevice = File::Spec->devnull ();
    open $fh, ">", $nulldevice or croak "Can't open $nulldevice: $!";
    flock $fh, 0;
    close $fh;
    1;
    };

sub complete_table_name {
    my ($self, $meta, $file, $respect_case) = @_;

    my $tbl = $file;
    if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER
        $tbl = uc $tbl;
	}
    elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER
        $tbl = lc $tbl;
	}

    $meta->{f_fqfn} = undef;
    $meta->{f_fqbn} = undef;
    $meta->{f_fqln} = undef;

    $meta->{table_name} = $tbl;

    return $tbl;
    } # complete_table_name

sub apply_encoding {
    my ($self, $meta, $fn) = @_;
    defined $fn or $fn = "file handle " . fileno ($meta->{fh});
    if (my $enc = $meta->{f_encoding}) {
	binmode $meta->{fh}, ":encoding($enc)" or