Commit 06df96ae authored by Nigel Kukard's avatar Nigel Kukard

Re-organization of files

parent a6723634
This diff is collapsed.
# Wiaflos server data cache library
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2007 Nigel Kukard <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
# Caching package
package wiaflos::server::cache;
use strict;
use warnings;
use wiaflos::version;
use wiaflos::constants;
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
cacheStoreKeyPair
cacheGetKeyPair
);
use Cache::FastMmap;
# Cache stuff
my $cache_type = "FastMmap";
my $cache;
# Our current error message
my $error = "";
# Set current error message
# Args: error_message
sub setError
{
my $err = shift;
my ($package,$filename,$line) = caller;
my (undef,undef,undef,$subroutine) = caller(1);
# Set error
$error = "$subroutine($line): $err";
}
# Return current error message
# Args: none
sub Error
{
my $err = $error;
# Reset error
$error = "";
# Return error
return $err;
}
# Initialize cache
sub Init
{
my $server = shift;
my $ch;
# Create Cache
$ch = Cache::FastMmap->new(
'page_size' => 1024,
'num_pages' => 2048,
'raw_values' => 1,
'unlink_on_exit' => 1,
);
# Stats
$ch->set('Cache/Stats/Hit',0);
$ch->set('Cache/Stats/Miss',0);
# Set server vars
$server->{'cache_engine'}{'handle'} = $ch;
};
# Destroy cache
sub Destroy
{
my $server = shift;
};
# Connect child to cache
sub connect
{
my $server = shift;
$cache = $server->{'cache_engine'}{'handle'};
}
# Disconnect child from cache
sub disconnect
{
my $server = shift;
}
# Store keypair in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
# Value - Item value
sub cacheStoreKeyPair
{
my ($cacheName,$key,$value) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in store");
return ERR_SRVCACHE;
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' store");
return ERR_SRVCACHE;
}
if (!defined($value)) {
setError("Value not defined for cache '$cacheName' key '$key' store");
return ERR_SRVCACHE;
}
# If we're not caching just return
return 0 if ($cache_type eq 'none');
# Store
$cache->set("$cacheName/$key",$value);
return 0;
}
# Get data from key in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
sub cacheGetKeyPair
{
my ($cacheName,$key) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in get");
return (ERR_SRVCACHE);
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' get");
return (ERR_SRVCACHE);
}
# If we're not caching just return
if ($cache_type eq 'none') {
return (RES_OK,undef);
}
# Check and count
my $res = $cache->get("$cacheName/$key");
if ($res) {
$cache->get_and_set('Cache/Stats/Hit',sub { return ++$_[1]; });
} else {
$cache->get_and_set('Cache/Stats/Miss',sub { return ++$_[1]; });
}
return (RES_OK,$res);
}
# Return cache hit ratio
sub getHitRatio
{
my $res;
# Get counter
$res = $cache->get('Cache/Stats/Hit');
return $res;
}
# Return cache miss ratio
sub getMissRatio
{
my $res;
# Get counter
$res = $cache->get('Cache/Stats/Miss');
return $res;
}
1;
# vim: ts=4
# Database independent layer module
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package wiaflos::server::dbilayer;
use strict;
use warnings;
use wiaflos::server::config;
use DBI;
use Data::Dumper;
my $internalError = "";
sub internalErr
{
my $error = $internalError;
$internalError = "";
return $error;
}
# Initialize class and return a fully connected object
sub Init
{
my $server = shift;
my $dbconfig = $server->{'wiaflos'}->{'database'};
# Check if we created
my $dbh = wiaflos::server::dbilayer->new($dbconfig->{'DSN'},$dbconfig->{'Username'},$dbconfig->{'Password'});
return undef if (!defined($dbh));
return $dbh;
}
# Constructor
sub new
{
my ($class,$dsn,$username,$password) = @_;
# Iternals
my $self = {
_dbh => undef,
_error => undef,
_dsn => undef,
_username => undef,
_password => undef,
_in_transaction => undef,
};
# Set database parameters
if (defined($dsn)) {
$self->{_dsn} = $dsn;
$self->{_username} = $username;
$self->{_password} = $password;
} else {
$internalError = "Invalid DSN given";
return undef;
}
# Create...
bless $self, $class;
return $self;
}
# Return current error message
# Args: none
sub Error
{
my ($self) = @_;
my $err = $self->{_error};
# Reset error
$self->{_error} = "";
# Return error
return $err;
}
# Return connection to database
# Args: none
sub connect
{
my ($self) = @_;
$self->{_dbh} = DBI->connect($self->{_dsn}, $self->{_username}, $self->{_password}, {
'AutoCommit' => 1,
'PrintError' => 0
});
# Connect to database if we have to, check if we ok
if (!$self->{_dbh}) {
$self->{_error} = "Error connecting to database: $DBI::errstr";
return -1;
}
# Apon connect we are not in a transaction
$self->{_in_transaction} = 0;
return 0;
}
# Check database connection
# Args: none
sub _check
{
my $self = shift;
# If we not in a transaction try connect
if ($self->{_in_transaction} == 0) {
# Try ping
if (!$self->{_dbh}->ping()) {
# Disconnect & reconnect
$self->{_dbh}->disconnect();
$self->connect();
}
}
}
# Return database selection results...
# Args: <select statement>
sub select
{
my ($self,$query) = @_;
$self->_check();
# Prepare query
my $sth;
if (!($sth = $self->{_dbh}->prepare($query))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
# Check for execution error
if (!$sth->execute()) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Perform a command
# Args: <command statement>
sub do
{
my ($self,$command) = @_;
$self->_check();
# Prepare query
my $sth;
if (!($sth = $self->{_dbh}->do($command))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Function to get last insert id
# Args: <table> <column>
sub lastInsertID
{
my ($self,$table,$column) = @_;
# Get last insert id
my $res;
if (!($res = $self->{_dbh}->last_insert_id(undef,undef,$table,$column))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to begin a transaction
# Args: none
sub begin
{
my ($self) = @_;
$self->_check();
$self->{_in_transaction}++;
# Don't really start transaction if we more than 1 deep
if ($self->{_in_transaction} > 1) {
return 1;
}
# Begin
my $res;
if (!($res = $self->{_dbh}->begin_work())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to commit a transaction
# Args: none
sub commit
{
my ($self) = @_;
# Reduce level
$self->{_in_transaction}--;
# If we not at top level, return success
if ($self->{_in_transaction} > 0) {
return 1;
}
# Reset transaction depth to 0
$self->{_in_transaction} = 0;
# Commit
my $res;
if (!($res = $self->{_dbh}->commit())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to rollback a transaction
# Args: none
sub rollback
{
my ($self) = @_;
# If we at top level, return success
if ($self->{_in_transaction} < 1) {
return 1;
}
$self->{_in_transaction} = 0;
# Rollback
my $res;
if (!($res = $self->{_dbh}->rollback())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to quote a database variable
# Args: <stuff to quote>
sub quote
{
my ($self,$stuff) = @_;
return $self->{_dbh}->quote($stuff);
}
# Function to cleanup DB query
# Args: <sth>
sub free
{
my ($self,$sth) = @_;
if ($sth) {
$sth->finish();
}
}
1;
# vim: ts=4
# Common database layer module
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package wiaflos::server::dblayer;
use strict;
use warnings;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
DBConnect
DBSelect
DBDo
DBLastInsertID
DBBegin
DBCommit
DBRollback
DBQuote
DBFreeRes
DBSelectNumResults
);
use wiaflos::server::config;
use wiaflos::server::dbilayer;
# Database handle
my $dbh = undef;
# Our current error message
my $error = "";
# Set current error message
# Args: error_message
sub setError
{
my $err = shift;
my ($package,$filename,$line) = caller;
my (undef,undef,undef,$subroutine) = caller(1);
# Set error
$error = "$subroutine($line): $err";
}
# Return current error message
# Args: none
sub Error
{
my $err = $error;
# Reset error
$error = "";
# Return error
return $err;