{
    package DBD::ExampleP;
    @EXPORT = qw(); # Do NOT @EXPORT anything.

# $Id: ExampleP.pm,v 1.3 1994/10/12 15:18:27 timbo Exp $
#
# Copyright (c) 1994, Tim Bunce
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.

    @statnames = qw(dev ino mode nlink uid gid
	rdev size atime mtime ctime blksize blocks name);
    @statnames{@statnames} = (0 .. @statnames-1);
    @stattypes = qw(1 1 1 1 1 1 1 1 3 3 3 1 1 2);
    @stattypes{@statnames} = @stattypes;

    $drh = undef;	# holds driver handle once initialised
    $gensym = "SYM000"; # used by st::execute() for filehandles

    sub driver{
	return $drh if $drh;
	my($class, $attr) = @_;
	$class .= "::dr";
	($drh) = DBI::_new_drh($class, {
	    'Name' => 'ExampleP',
	    'Version' => '$Revision: 1.3 $',
	    'Attribution' => 'DBD Example Perl stub by Tim Bunce',
	    });
	$drh;
    }

    1;
}


{   package DBD::ExampleP::dr; # ====== DRIVER ======
    use strict;
    # we use default (dummy) connect method
}


{   package DBD::ExampleP::db; # ====== DATABASE ======
    use strict;

    sub prepare {
	my($dbh, $statement)= @_;
	my($fields, $param) = $statement =~ m/^select ([\w,\s]+) from (.*)/i;
	my(@fields) = split(/\s*,\s*/, $fields);

	my(@bad) = map($DBD::ExampleP::statnames{$_} ? () : $_, @fields);
	return anerror $dbh "Unknown field names: @bad" if @bad;

	my($outer, $sth) = DBI::_new_sth($dbh, {
	    'Statement'     => $statement,
	    'fields'        => \@fields,
	    'NUM_OF_FIELDS' => sub { scalar(@{$_[0]->{'fields'}}) },
	    });

	$outer;
    }

}


{   package DBD::ExampleP::st; # ====== STATEMENT ======
    use strict; no strict 'refs'; # cause problems with filehandles

    sub execute {
	my($sth, $dir) = @_;
	$sth->finish;
	$sth->{'datahandle'} = "DBD::ExampleP::".++$DBD::ExampleP::gensym;
	opendir($sth->{'datahandle'}, $dir)
		or return anerror $sth "opendir($dir): $!";
	$sth->{'dir'} = $dir;
	1;
    }

    sub fetchrow {
	my($sth) = @_;
	my $f = readdir($sth->{'datahandle'});
	unless($f){
	    $sth->finish;     # no more data so finish
	    return ();
	}
	my(%s); # fancy a slice of a hash?
	# put in all the data fields
	@s{@DBD::ExampleP::statnames} = (stat("$sth->{'dir'}/$f"), $f);
	# return just what fields the query asks for
	@s{ @{$sth->{'fields'}} };
    }

    sub finish {
	my($sth) = @_;
	return undef unless $sth->{'datahandle'};
	closedir($sth->{'datahandle'});
	$sth->{'datahandle'} = undef;
    }

    sub FETCH {
	my ($sth, $attrib) = @_;
	# In reality this would interrogate the database engine to
	# either return dynamic values that cannot be precomputed
	# or fetch and cache attribute values too expensive to prefetch.
	if ($attrib eq 'DATA_TYPE'){
	    my(@t) = @DBD::ExampleP::stattypes{@{$sth->{'fields'}}};
	    return \@t;
	}
	warn "$sth: fetch unknown attribute '$attrib'\n";
	return undef; # unknown attribute
    }

    sub STORE {
	my ($sth, $attrib, $value) = @_;
	# would normally validate and only store known attributes
	warn "$sth: store unknown attribute '$attrib'\n";
	$sth->{$attrib} = $value;
    }

}

1;
