view release on metacpan or  search on metacpan

lib/Statistics/Covid/IO/Base.pm  view on Meta::CPAN

use 5.006;
use strict;
use warnings;

use Data::Dump qw/pp/;
use Storable;
use File::Copy;
use File::Temp;
use Try::Tiny;

use Statistics::Covid::Utils;

our $VERSION = '0.23';

sub	new {
	my (
		$class,
		# Specify the Schema class, this is
		#   Statistics::Covid::Schema
		# and it is fixed for this application.
		$schema_package_name,

		# Specify the class we are doing IO for
		# it must be a child of: Statistics::Covid::IO::DualBase
		# and represents a class which stores its fields in memory
		# as well as in a table in DB (with the aid of DBIx::Class)
		# this can be:
		#    Statistics::Covid::Datum (for Datum table)
		# or
		#    Statistics::Covid::Version (for Version table)
		# (and more, as many as your tables in DB)
		$dual_package_name,

		# a hash of additional parameters, of which
		# config-file or config-hash are necessary
		$params
	) = @_;
	if( ! defined $dual_package_name ){ warn "error, a dual_package_name must be specified as the 2nd parameter (and schema_package_name as a 1st), 3rd parameter must be a parameters hash with at least a config-file or config-hash entry."; return undef ...

	$params = {} unless $params;
	my $self = {
		'debug' => 0,
		'log-filename' => undef,

		# internal variables, nothing to see here:
		# what schema we are doing the IO for? 
		# something like: 'Statistics::Covid::Schema' (as a string)
		'schema-package-name' => undef,
		# this is a string with the name of the package which acts as our dual
		# and contains all the data which must go to DB
		# e.g. Statistics::Covid::Datum
		'dual-package-name' => undef,
		# some 'our' vars in the dual package which should be already defined in here
		# e.g. the tablename, db spec, etc.
		'dual-package-vars' => undef,
		# a hash with our configuration as read from file or set via the config* subs
		# this reflects exactly the configuration json file (e.g. t/example-config.json)
		# with 'dbparams' as subhash
		'config-hash' => undef,
	};
	bless $self => $class;

	# we accept a debug level parameter>=0
	if( exists $params->{'debug'} ){ $self->debug($params->{'debug'}) }

	if( ! defined $schema_package_name ){ warn "error, you need to specify a schema package name as a string, like 'Statistics::Covid::Schema'."; return undef }
	$self->{'schema-package-name'} = $schema_package_name;
	if( ! defined $dual_package_name ){ warn "error, you need to specify a dual-object package name as a string, like 'Statistics::Covid::Datum'."; return undef }
	$self->{'dual-package-name'} = $dual_package_name;
	if( $self->debug() > 0 ){ warn "creating an IO object for inserting objects of type '$dual_package_name' into DB." }
	{
		no strict 'refs';
		die "table schema package '".$dual_package_name.'::Table::SCHEMA'."' can not be found, does it exist?"
			unless defined ${$dual_package_name.'::Table::SCHEMA'};
		$self->{'dual-package-vars'} = Storable::dclone(${$dual_package_name.'::Table::SCHEMA'});
		if( $self->debug() > 0 ){ warn "loaded the table schema from ".$dual_package_name.'::Table::SCHEMA'."\n" }
	}

	# declare a log file to be used for db operations, you must additionally set debug>0
	if( exists $params->{'log-filename'} ){ $self->logfilename($params->{'log-filename'}) }

	# we accept config-file or config-hash, see t/example-config.json for an example
	if( exists $params->{'config-file'} ){ if( ! $self->config_file($params->{'config-file'}) ){ warn "error, call to config_file() has failed."; return undef } }
	elsif( exists $params->{'config-hash'} ){ if( ! $self->config($params->{'config-hash'}) ){ warn "error, call to config() has failed."; return undef } }
	else { warn "error, no configuration was specified via 'config-file' or 'config-hash'."; return undef }
	return $self;
}
# construct the db filename, if one is used (SQLite)
# returns undef on failure
# returns the db filename for the case of SQLite
# or an empty string for the case of MySQL
sub	db_filename {
	my $self = $_[0];
	my $dbparams = $self->dbparams();
	my $current_db_file = "";
	if( $dbparams->{'dbtype'} eq 'SQLite' ){
		if( exists $dbparams->{'dbdir'} and defined $dbparams->{'dbdir'} and $dbparams->{'dbdir'} ne '' ){
			$current_db_file = File::Spec->catdir($dbparams->{'dbdir'}, $dbparams->{'dbname'})
		} else { $current_db_file = $dbparams->{'dbname'} }
		return $current_db_file;
	} elsif( $dbparams->{'dbtype'} eq 'MySQL' ){ return $current_db_file }
	warn "don't know this dbtype '".$dbparams->{'dbtype'}."'.";
	return undef # failed
}
# does a backup of the DB
# it currently works for SQLite by copying it to a new file
# and returns that new file's filename
# for MySQL i did not want to shell out and use mysqldump
# so the commands to do that from a terminal/command prompt
# are printed and the program does not complain (but informs)
# it returns the backup filename on success
# or undef on failure
sub	db_create_backup_file {
	my $self = $_[0];
	# optional output file, or default
	my $outfile = defined($_[1]) ? $_[1] : Statistics::Covid::Utils::make_timestamped_string() . '.bak';
	
	my $dbparams = $self->dbparams();
	if( $dbparams->{'dbtype'} eq 'SQLite' ){
		my $current_db_file = "";
		if( exists $dbparams->{'dbdir'} and defined $dbparams->{'dbdir'} and $dbparams->{'dbdir'} ne '' ){