view release on metacpan or  search on metacpan

lib/Database/Abstraction.pm  view on Meta::CPAN

	if(my $logger = $params->{'logger'}) {
		if(Scalar::Util::blessed($logger)) {
			$self->{'logger'} = $logger;
		} else {
			$self->{'logger'} = Log::Abstraction->new($logger);
		}
		return $self;
	}
	Carp::croak('Usage: set_logger(logger => $logger)')
}

# Open the database connection based on the specified type (e.g., SQLite, CSV).
# Read the data into memory or establish a connection to the database file.
# column_names allows the column names to be overridden on CSV files

sub _open
{
	# Enforce that _open is only reachable from within this class hierarchy;
	# caller() returns the calling package name as a plain string.
	do { my $c = (caller)[0]; Carp::croak('Illegal Operation: _open may only be called within ', __PACKAGE__) unless $c && $c->isa(__PACKAGE__) };

	my $self = shift;
	my $params = Params::Get::get_params(undef, @_);

	$params->{'sep_char'} ||= $self->{'sep_char'} ? $self->{'sep_char'} : '!';
	my $max_slurp_size = $params->{'max_slurp_size'} || $self->{'max_slurp_size'};

	my $table = $self->{'table'} || ref($self);
	$table =~ s/.*:://;

	$self->_trace(ref($self), ": _open $table");

	return if($self->{$table});

	# Read in the database
	my $dbh;

	# DSN-based connection bypasses file detection entirely
	if(my $dsn = $self->{'dsn'} || $defaults{'dsn'}) {
		require DBI && DBI->import() unless DBI->can('connect');

		my $dialect = 'generic';
		if    ($dsn =~ /^dbi:SQLite:/i) { $dialect = 'sqlite'   }
		elsif ($dsn =~ /^dbi:Pg:/i)     { $dialect = 'postgres' }
		elsif ($dsn =~ /^dbi:mysql:/i)  { $dialect = 'mysql'    }
		$self->{'_dialect'} = $dialect;

		$dbh = DBI->connect(
			$dsn,
			$self->{'username'},
			$self->{'password'},
			{ RaiseError => 1, AutoCommit => 1 },
		) or Carp::croak(ref($self), ": cannot connect: $DBI::errstr");

		if($dialect eq 'sqlite') {
			$dbh->do('PRAGMA synchronous = OFF');
			$dbh->do('PRAGMA cache_size = -4096');
			$dbh->do('PRAGMA journal_mode = OFF');
			$dbh->do('PRAGMA temp_store = MEMORY');
			$dbh->do('PRAGMA mmap_size = 1048576');
			$dbh->sqlite_busy_timeout(100000);
		}

		$self->{'type'} = 'DBI';
		$self->{$table} = $dbh;
		$self->{'_updated'} = time();
		return $self;
	}

	my $dir = Cwd::abs_path($self->{'directory'} || $defaults{'directory'});
	my $dbname = $self->{'dbname'} || $defaults{'dbname'} || $table;
	Carp::croak(ref($self), ": unsafe dbname '$dbname'")
		unless $dbname =~ /^[a-zA-Z0-9_.-]+$/ && $dbname !~ /\.\./;
	my $slurp_file = File::Spec->catfile($dir, "$dbname.sql");

	$self->_debug("_open: try to open $slurp_file");

	# Look at various places to find the file and derive the file type from the file's name
	if(-r $slurp_file) {
		# SQLite file
		require DBI && DBI->import() unless DBI->can('connect');

		require DBD::SQLite::Constants;
		$dbh = DBI->connect("dbi:SQLite:dbname=$slurp_file", undef, undef, {
			sqlite_open_flags => DBD::SQLite::Constants::SQLITE_OPEN_READONLY(),
		});
	}
	if($dbh) {
		$dbh->do('PRAGMA synchronous = OFF');
		$dbh->do('PRAGMA cache_size = -4096');	# Use 4MB cache - negative = KB)
		$dbh->do('PRAGMA journal_mode = OFF');	# Read-only, no journal needed
		$dbh->do('PRAGMA temp_store = MEMORY');	# Store temp data in RAM
		$dbh->do('PRAGMA mmap_size = 1048576');	# Use 1MB memory-mapped I/O
		$dbh->sqlite_busy_timeout(100000);	# 10s
		$self->_debug("read in $table from SQLite $slurp_file");
		$self->{'type'} = 'DBI';
	} elsif($self->_is_berkeley_db(File::Spec->catfile($dir, "$dbname.db"))) {
		$self->_debug("$table is a BerkeleyDB file");
		$self->{'type'} = 'BerkeleyDB';
	} else {
		my $fin;
		# File::pfopen splits $path on ':' which breaks Windows drive letters
		# (C:\foo becomes ['C', '\foo']).  Since we always have a single directory
		# we use File::Spec->catfile directly — same behaviour, portable.
		for my $ext (qw(csv.gz db.gz)) {
			my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
			next unless -r $candidate;
			open($fin, '<', $candidate) or next;
			$slurp_file = $candidate;
			last;
		}
		if(defined($slurp_file) && (-r $slurp_file)) {
			require Gzip::Faster;
			Gzip::Faster->import();

			close($fin);
			$fin = File::Temp->new(SUFFIX => '.csv', UNLINK => 1);
			print $fin gunzip_file($slurp_file);
			$fin->flush();
			$slurp_file = $fin->filename();
			$self->{'_temp_fh'} = $fin;	# Keep object alive; auto-unlinks at DESTROY
		} else {
			my $psv = File::Spec->catfile($dir, "$dbname.psv");
			if(-r $psv && open($fin, '<', $psv)) {
				# Pipe separated file
				$slurp_file = $psv;
				$params->{'sep_char'} = '|';
			} else {
				# CSV or BerkeleyDB-extension file
				for my $ext (qw(csv db)) {
					my $candidate = File::Spec->catfile($dir, "$dbname.$ext");
					next unless -r $candidate;
					open($fin, '<', $candidate) or next;
					$slurp_file = $candidate;
					last;
				}
			}
		}
		if(my $filename = $self->{'filename'} || $defaults{'filename'}) {
			Carp::croak(ref($self), ": unsafe filename '$filename'")
				unless $filename =~ /^[a-zA-Z0-9_.-]+$/ && $filename !~ /\.\./;
			$self->_debug("Looking for $filename in $dir");
			$slurp_file = File::Spec->catfile($dir, $filename);
		}
		if(defined($slurp_file) && (-r $slurp_file)) {
			close($fin) if(defined($fin));
			my $sep_char = $params->{'sep_char'};

			$self->_debug(__LINE__, ' of ', __PACKAGE__, ": slurp_file = $slurp_file, sep_char = $sep_char");

			if($params->{'column_names'}) {
				$dbh = DBI->connect("dbi:CSV:db_name=$slurp_file", undef, undef,
					{
						csv_sep_char => $sep_char,