view release on metacpan or  search on metacpan

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

}
sub	make_random_object {
	srand $_[0] if defined $_[0];
	die "you need to implement me";
	#return $obj
}
sub	toString {
	my $self = $_[0];
	die "you need to implement me";
}

###########
#### This constructor must not change and every class inheriting from us
#### must call it prior to doing their own 'constructor things'
#### it takes a hashref OR arrayref of params to initialise the fields
#### whose names are specified above as keys to the DBCOLUMNS_SPEC
###########

# create a Data item, either by supplying 1st input parameter,
# $params as a hashref of name=>value
# or
# $params as an array which must have as many elements
# as the 'db-columns' items and in the same order.
sub	new {
	my ($class, $dbschema, $params) = @_;
	$params = {} unless defined $params;

	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];

	if( ! defined $dbschema ){ warn "error, dbschema parameter was not specified."; return undef }

	my $self = {
		# our data goes here and that goes straight to DB
		'c' => {},
		# other private data we do not want to send to DB
		'p' => {
			# must be a hashref as below which is exactly what $dbschema must contain
			'db-specific' => $dbschema,
# example of the $dbschema
#			{
#				# ADD HERE YOUR TABLENAME
#				'tablename' => undef, # 'our table name'
#				'schema' => {
#					# ADD HERE YOUR FIELDS
#					# key is the internal name and also name in DB
#					# for example, this is the 'id' field, both in DB and in our $self
#					# it is of varchar data type (relevant only for DB),
#					# 'default_value' applies to both DB and $self
#					'id' => {data_type => 'varchar', is_nullable=>0, size=>100, default_value=>'<NA>'},
#					# ... add more fields
#				}, # end schema
#				# ADD HERE THE NAME OF THE FIELDS TO create the PK
#				'column-names-for-primary-key' => undef, # [qw/one or more keys from 'schema' to act as PK/]
#				'column-names' => undef, # will be created later by init as an arrayref
#				'num-columns' => -1, # later by init
#			}, # end db-specific fields
			'debug' => 0,
		},
	};
	bless $self => $class;

	my $c = $self->{'c'}; # content fields as they go to DB
	my $p = $self->{'p'}; # private fields
	my $d = $p->{'db-specific'};
	my $s = $d->{'schema'};

	# do some sanity checks first
	if( !exists($d->{'tablename'}) || !defined($d->{'tablename'}) ){ warn "error, 'tablename' was not specified in the dbschema parameter."; return undef }
	if( !exists($d->{'schema'}) || !defined($d->{'schema'}) ){ warn "error, 'schema' was not specified in the dbschema parameter."; return undef }
	if( !exists($d->{'column-names-for-primary-key'}) || !defined($d->{'column-names-for-primary-key'}) ){ warn "error, 'column-names-for-primary-key' was not specified in the dbschema parameter."; return undef }

	# populate our self with the data and set to default values (before checking input params)
	for my $aname (@{$d->{'column-names'}}){
		# create the field in $self and set its default value
		$c->{$aname} = $s->{$aname}->{'default_value'}
	}
	# now check input params for particular data values
	if( ref($params) eq 'HASH' ){
		# input params is a HASHref, we are allowed to have as little data as possible,
		# the rest will assume default values BUT those undef are illegal and must be filled as a minimum
		foreach my $k (@{$d->{'column-names'}}){
			if( exists $params->{$k} ){ $c->{$k} = $params->{$k} }
		}
		if( exists $params->{'debug'} ){ $self->debug($params->{'debug'}) }
	} elsif( ref($params) eq 'ARRAY' ){
		# input params is an ARRAYref, which is expected to have values FOR ALL DATA
		# this is used for cloning or loading from DB
		# IMPORTANT: order of the params array must be exactly the same as in the 'column-names' array
		# which is keys of 'schema' sorted alphabetically {$a cmp $b}
		if( @$params != $d->{'num-columns'} ){ warn "size of the array of parameters (".@$params.") is not the same as the size of our parameters (".$d->{'num-columns'}.")."; return undef }
		my $i = 0;
		foreach my $k (@{$d->{'column-names'}}){ $c->{$k} = $params->[$i++] }
	} else { warn "parameter can be a hashref or an arrayref with values"; return undef }

	# TODO: automatically insert getters and setter subs for each column name in the schema

	# now check if anything is left undef, this is an error
	foreach my $k (@{$d->{'column-names'}}){
		if( ! defined $c->{$k} ){
			print STDERR pp($params)."\n\n$whoami (via $parent) : parameter '$k' was not specified or left undefined and that's not allowed, input data is above.\n";
			return undef
		}
	}
	return $self
}
sub	column_value {
	my $self = $_[0];
	my $column_name = $_[1];
	if( ! $self->column_name_is_valid($column_name) ){ die "column name '$column_name' does not exist." }
	return $self->{'c'}->{$column_name}
}
sub	column_name_is_valid { return exists $_[0]->{'c'}->{$_[1]} }
###########
#### Nothing to change below, the subs to implement and overwrite are those above
###########
# compares this object with another and returns 0 if different or 1 if the same
sub	equals {
	my $self = $_[0];
	my $another = $_[1];
	my $res;