<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
package dbwide;
use strict;

#############################################################################
# Software : dbwide.pm                                                                                                                                                                         #
# Primary Author : Zohaer Naqvi                                                                                                                                                          #
# Moderators/Improvers : Add your name here if you modify this perl module.                                                                               #
# You are free to copy, alter, distribute or re-distribute this software under the terms of Artistic License 2.0                              #
############################################################################

my @tables = undef;
my %resultobj;

#scalar switches for subroutines########################################################
my($fetchrows, $delrows) = undef;

#constructors###################################################################
sub _select {
	
	my @class = @_;
	my $properties = {
		
		_connection =&gt; undef,
		_wherestr =&gt; $class[1],
		_properties =&gt; undef
	
	};
	bless $properties, $class[0];
	sub_lock(\$delrows);
	sub_unlock(\$fetchrows);
	return $properties;

}

sub _delete {
	
	my @class = @_;
	my $properties = {
		
		_connection =&gt; undef,
		_wherestr =&gt; $class[1],
		_properties =&gt; undef
	
	};
	bless $properties, $class[0];
	sub_lock(\$fetchrows);
	sub_unlock(\$delrows);
	return $properties;

}


#control methods################################################################
sub access {

	my($object, $node) = @_;
	return $object-&gt;{$node};

}

sub sub_lock {

	my @subs = @_;
	my $sub = undef;
	foreach $sub (@subs){

		${$sub} = 0;

	}

}

sub sub_unlock {

	my @subs = @_;
	my $sub = undef;
	foreach $sub (@subs){
		${$sub} = 1;
	}

}

#resource methods###############################################################
sub connection{

	my($object, $connection) = @_;

	if(defined($connection)){

		$object-&gt;{_connection} = $connection;
		populate($connection);

	}

	return $object-&gt;{_connection};

}

sub populate {
	
	my $connection = shift;
	my $table = undef;
	my $i=0;
	my $query = qq{SHOW TABLES};
	my $schema = $connection-&gt;prepare($query);

	$schema-&gt;execute() || return 0;

	while($table = $schema-&gt;fetchrow_array()){
		$tables[$i] = $table;
		$i++;
	}

	return 1;
}

#operation methods##################################################################

sub fetchrows {
	if($fetchrows == 1){
		my($object) = @_;
		my $connection = $object-&gt;{_connection};
		my $wherestr = $object-&gt;{_wherestr};
		if(defined($connection)){
			
			my $table = undef;
			my $row = undef;

			table: foreach $table (@tables){
	
			my $query = "SELECT * FROM $table $wherestr";
			my $results = $connection-&gt;prepare($query) || die("cannot prepare query");
			$results-&gt;execute() || next table;
			my @rows = {};

			while($row = $results-&gt;fetchrow_hashref()){

			push(@rows, $row);

			}

			@{$resultobj{$table}} = @rows;

			}

			$object-&gt;{_properties} =  \%resultobj;

			return 1;
		}
		else {
			return 0;
		}
	}
	else {

		return 0;
	
	}
}

sub delrows {
	if($delrows == 1){
		my($object) = @_;
		my $connection = $object-&gt;{_connection};
		my $wherestr = $object-&gt;{_wherestr};
		if(defined($connection)){
			
			my $table = undef;

			table: foreach $table (@tables){
	
			my $query = "DELETE FROM $table $wherestr";
			my $results = $connection-&gt;prepare($query) || die("cannot prepare query");
			$results-&gt;execute() || next table;
			
			}

			$object-&gt;{_properties} =  1;

			return 1;
		}
		else {
			$object-&gt;{_properties} =  0;
			return 0;
		}
	}
	else {

		return 0;
	
	}
}

1;</pre></body></html>