Group
Extension

Statistics-Covid/script/db-search-and-make-new-db.pl

#!/usr/bin/env perl

use strict;
use warnings;

our $VERSION = '0.23';

use Getopt::Long;

use Data::Dump qw/pp/;

my $configfile1 = undef;
my $configfile2 = undef;
my $tablename = undef;
my $DEBUG = 0;
my $conditions = undef;
my $attributes = undef;
my $clear_db_before = 0;

if( ! Getopt::Long::GetOptions(
	'config-file-source=s' => \$configfile1,
	'config-file-destination=s' => \$configfile2,
	'conditions=s' => \$conditions,
	'attributes=s' => \$attributes,
	'tablename=s' => \$tablename,
	'clear' => \$clear_db_before,
	'debug=i' => \$DEBUG,
) ){ die usage() . "\n\nerror in command line."; }

die usage() . "\n\nA 'source' configuration file (--config-file-src) is required." unless defined $configfile1;
die usage() . "\n\nA 'destination' configuration file (--config-file-destination) is required." unless defined $configfile2;

my $package = 'Statistics::Covid::'.$tablename.'::IO';
my $packagefile = $package.'.pm'; $packagefile =~ s|\:\:|/|g;

eval { require $packagefile; 1; };
die "failed to load packagefile '$packagefile'. Most likely table '$tablename' is unknown or was wrongly capitalised, e.g. the 'Datum' table is correct : $@"
	if $@;

my $io1 = $package->new({
	'config-file' => $configfile1,
	'debug' => $DEBUG,
}) or die $package."->new() failed (1)";
die "failed to connect to source database using config-file '$configfile1'"
	unless $io1->db_connect();

my $db_select_params = {};
if( defined $conditions ){
	my $pvc = eval $conditions;
	die "Syntax errors in the specified conditions '$conditions'"
		unless defined $pvc;
	$db_select_params->{'conditions'} = $pvc;
}
if( defined $attributes ){
	my $pva = eval $attributes;
	die "Syntax errors in the specified attributes '$attributes'"
		unless defined $pva;
	$db_select_params->{'attributes'} = $pva;
}
my $objs = $io1->db_select($db_select_params);
die pp($db_select_params)."\n\ncall to db_select() has failed for the above parameters"
	unless defined $objs;
die pp($db_select_params)."\n\nnothing was selected for the above parameters"
	if scalar(@$objs)==0;

die "db_disconnect() failed for source db"
	unless $io1->db_disconnect();
my $io2 = $package->new({
	'config-file' => $configfile2,
	'debug' => $DEBUG,
}) or die $package."->new() failed (2)";

die "failed to connect to destination database using config-file '$configfile2'"
	unless $io2->db_connect();

my $count1 = $io2->db_count();

if( $clear_db_before == 1 ){
	die "call to db_clear() failed" unless $io2->db_clear()>=0;
}

my $ret = $io2->db_insert_bulk($objs);
die "db_insert_bulk() failed" unless defined $ret;

my $count2 = $io2->db_count();

print "$0 : success, destination database updated (table '$tablename'):\n" . pp($ret) . "\n";
print "$0 : rows in '$tablename' before : $count1\n";
print "$0 : rows in '$tablename' after  : $count2\n";

die "db_disconnect() failed for destination db"
	unless $io2->db_disconnect();

#### end

sub usage {
	return "Usage : $0 <options>\n"
	. " --config-file-src C : specify a configuration file for doing IO with the source database.\n"
	. " --config-file-destination C : specify a configuration file for doing IO with the destination database.\n"
	. " --tablename T : specify the tablename for the SELECT, this corresponds to a package- name : Statistics::Covid::<tablename>::IO, so use the exact same capitalisation (e.g. 'Datum' and not 'datum').\n"
	. "[--clear : erase all contents of the destination database, if any and if it does indeed exist.]"
	. "[--conditions C : specify SELECT conditions as a string representing a Perl hashref adhering to the search-conditions expected by SQL::Abstract. For example, \"{'name' => {'like'=>'%ABC'}}\" See https://metacpan.org/pod/SQL::Abstract#WHERE-CLAUSES ]\n"
	. "[--attributes A : specify SELECT attributes as a string representing a Perl hashref adhering to the search-attributes expected by SQL::Abstract. In order to limit the number of rows selected use: '{rows=>10}', see https://metacpan.org/pod/DBIx::Class::ResultSet#ATTRIBUTES]\n"
	. "[--debug Level : specify a debug level, anything >0 is verbose.]\n"
	. "\n\nThis program will open the source database, extract objects from specified table using the optionally specified conditions and/or attributes and write them onto the same table into the destination database.\n"
	. "\nExample usage:\n"
. <<'EXA'
db-search-and-make-new-db.pl --config-file-source config/config.json --config-file-destination config/destination.json --tablename 'Datum' --conditions "{'name'=>'Hackney'}" --attributes "{'rows'=>3}"
EXA
	. "\nProgram by Andreas Hadjiprocopis (andreashad2\@gmail.com / bliako\@cpan.org)\n"
	;
}


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.