database

my $db = zBase->new();
my %record;

###############################################
# YaBB2: Yet another Bulletin Board version 2 #
###############################################
# Open Source project, released under YPL     #
# Originally founded by:                      #
# Zef Hemel(zef@zefnet.com)                   #
# <a href="http://www.yabb.org" class="bb-url">http://www.yabb.org</a>                         #
###############################################
# This file is copyrighted, and written by:   #
# Zef Hemel (zef@zefnet.com)                  #
###############################################

use strict;

my $splitc = '\|';
my $joinc = '|';
my $replacecby = '&pipe;';
my $linefeedsplit = '\&lf;';
my $linefeedjoin = '&lf;';

# Syntax: $object = zBase->new();
# Creates a new zBase object

sub new {
my $self = {};
$self->{filename} = undef;
$self->{nextrec} = 0;
$self->{nextqueryrec} = 0;
$self->{EODB} = 0;
$self->{EOQR} = 0;
$self->{db} = ();
$self->{fieldnames} = {};
$self->{queryresults} = ();
$self->{totalrecs} = undef;
$self->{totalqueryresults} = undef;
$self->{modified} = 0;
$self->{fullyread} = 0;
# $self->{reversed} = 0;
$self->{readfrom} = 0;
$self->{recsstart} = 0;
$self->{addrecs2end} = ();
bless $self;
return $self;
}

# Syntax: $object->connect("filename");
# Connects to the given database

sub connect {
my $self = shift;
my $filename = shift;
my $line;
my @farray;
my $i;

$filename =~ s/ /_/go;
open(DB, "<$filename") or Common::warning("File $filename cannot be found: $!");
Common::lock(*DB);
$line = <DB>;
$self->{readfrom} = tell(DB);
$self->{recsstart} = tell(DB);
Common::unlock(*DB);
close(DB);
chomp($line);
@farray = split(/$splitc/, $line);
for($i=0;$i<@farray;++$i) {
$self->{fieldnames}{$farray[$i]} = $i;
}
$self->{filename} = $filename;
$self->{nextrec} = 0;
return 1;
}

# Syntax: $object->create(-filename=>"filename",%fieldnames);
# Creates a new database with the given fieldnames ($fieldnames{'id'}=0 etc.)

sub create {
my ($self, %values) = @_;
my $filename = $values{'-filename'};
my @array;
my $line;

$self->{filename} = $filename;

foreach (sort keys %values) {
$array[$values{$_}] = $_;
}
$line = join($joinc, @array);
open(DB, ">$filename") or Common::warning("Could not create $filename: $!");
Common::lock(*DB);
print DB "$line\n";
Common::unlock(*DB);
close(DB);
zBase::connect($self, $filename);
zBase::read($self,0);
}

# Syntax: $object->read([numtoread]);
# Reads either the whole or a part of the db into the memory

sub read {
my $self = shift;
my $numtoread = shift;
my $i;

if($self->{fullyread}) { return 0; }
$self->{db} = ();
open(DB, "<$self->{filename}") or Common::warning("File $self->{filename} cannot be found");
Common::lock(*DB);
seek(DB, $self->{readfrom}, 0);
if(!$numtoread) {
push(@{$self->{db}}, <DB>);
$self->{fullyread} = 1;
} else {
for($i=0;$i<$numtoread;++$i) {
if(!eof(DB)) { $self->{db}[$i] = <DB>; }
}
$self->{readfrom} = tell(DB);
}
Common::unlock(*DB);
close(DB);
chomp @{$self->{db}};
$self->{totalrecs} = @{$self->{db}};
if($self->{totalrecs} == 0) { $self->{EODB} = 1; } else { $self->{EODB} = 0; }
}

# Syntax: $object->getnext([id]);
# Returns the id-th record fields splitted. If no id specified it uses the next
# Specifying id is depreciated

sub getnext {
my $self = shift;
my $rec = $self->{nextrec};
my @values = ();
my $i;
my %record;

if(@_) { $rec = shift; }
if($rec==0) { $self->{EODB}=0; }
@values = split(/$splitc/, ${$self->{db}}[$rec]);
@values = deformatarray(@values);
foreach (sort keys %{$self->{fieldnames}}) {
$record{$_} = $values[$self->{fieldnames}{$_}];
}
if($self->{nextrec} < $self->{totalrecs}) {
$self->{nextrec} = $rec+1;
if($self->{nextrec} == $self->{totalrecs}) { $self->{EODB}=1; }
return %record;
}
}

# Syntax: $object->add(-location=>'bottom'|'top', %values);
# Adds the specified record to the database

sub add {
my ($self,%params) = @_;
my $location = $params{'-location'};
my @record = ();
#my @newdb = ();
my $recordline;

zBase::read($self);
foreach (sort keys %params) {
$record[$self->{fieldnames}{$_}] = $params{$_} if($_ ne '-location');
}
@record = formatarray(@record);
$recordline = join($joinc, @record);
if($location eq "top") {
unshift(@{$self->{db}}, $recordline);
}
elsif($location eq "bottom") {
push(@{$self->{db}}, $recordline);
}
++$self->{totalrecs};
if($self->{totalrecs}>1) { $self->{EODB} = 0; }
$self->{modified} = 1;
}

# Syntax: $object->add(-where=>"somefield=value", -location=>'bottom'|'top', %values);
# Modifies the records which match -where

sub modify {
my ($self,%params) = @_;
my $location = $params{'-location'};
my $where = $params{'-where'};
my $i;
my $type;
my ($fieldname, $fieldid, $value);
my @record;
my $record2add = "";
my @newdb;

zBase::read($self);
$where =~ s/ = /=/g;
if($where =~ /=/) {
($fieldname, $value) = split(/=/, $where);
$type="=";
$fieldid = $self->{fieldnames}{$fieldname};
}
for($i=0;$i<@{$self->{db}};++$i) {
@record = split(/$splitc/, $self->{db}[$i]);
if($type eq "=" && $record[$fieldid] eq $value) {
foreach (sort keys %params) {
$record[$self->{fieldnames}{$_}] = $params{$_} if($_ ne '-location' && $_ ne '-where');
}
@record = formatarray(@record);
if(!$location) { $self->{db}[$i] = join($joinc, @record); }
else { $record2add = join($joinc, @record); }
} elsif($location) {
push(@newdb, $self->{db}[$i]);
}
}
if($location eq "top") {
@{$self->{db}} = ($record2add, @newdb);
} elsif($location eq "bottom") {
@{$self->{db}} = (@newdb, $record2add);
}
$self->{modified} = 1;
}

# Syntax: $object->delete(-where=>"fieldname=value");
# Deletes the records which match -where

sub delete {
my ($self,%params) = @_;
my $where = $params{'-where'};
my $i;
my $type;
my ($fieldname, $fieldid, $value);
my @record;
my @newdb = ();
my $numdeleted = 0;

zBase::read($self);
$where =~ s/ = /=/g;
if($where =~ /=/) {
($fieldname, $value) = split(/=/, $where);
$type="=";
$fieldid = $self->{fieldnames}{$fieldname};
}
for($i=0;$i<@{$self->{db}};++$i) {
@record = split(/$splitc/, $self->{db}[$i]);
if($type eq "=" && $record[$fieldid] ne $value) {
push(@newdb, $self->{db}[$i]);
} else { ++$numdeleted; }
}
@{$self->{db}} = @newdb;
$self->{totalrecs} = $self->{totalrecs} - $numdeleted;
if($self->{nextrec} >= $self->{totalrecs}) { $self->{EODB}=1; }
$self->{modified} = 1;
}

# Syntax: $object->query(-where=>"fieldname=value");
# Puts all records which match -where in its memory to be retrieved by nextquery()

sub query {
my ($self,%params) = @_;
my $where = $params{'-where'};
my $currec;
my @temprec;
my $type;
my ($fieldname, $value, $fieldid);

@{$self->{queryresults}} = ();
$self->{totalqueryresults} = 0;
$self->{EOQR} = 0;

$where =~ s/ = /=/g;
if($where =~ /=/) {
($fieldname, $value) = split(/=/, $where);
$type="=";
$fieldid = $self->{fieldnames}{$fieldname};
}
foreach $currec (@{$self->{db}}) {
@temprec = split(/$splitc/, $currec);
if($type eq "=" && $temprec[$fieldid] eq $value) {
push(@{$self->{queryresults}}, $currec);
++$self->{totalqueryresults};
}
}
if($self->{totalqueryresults} == 0) { $self->{EOQR} = 1; }
$self->{nextqueryrec} = 0;
}

# Syntax: $object->getnextquery([id]);
# Retrieves the next (or id-th) record of the query results

sub getnextquery {
my $self = shift;
my $rec = $self->{nextqueryrec};
my @values = ();
my %record;
my $i;

if(@_) { $rec = shift; }
if($rec==0) { $self->{EOQR}=0; }
@values = split(/$splitc/, ${$self->{queryresults}}[$rec]);
@values = deformatarray(@values);
foreach (sort keys %{$self->{fieldnames}}) {
$record{$_} = $values[$self->{fieldnames}{$_}];
}
if($self->{nextqueryrec} < $self->{totalqueryresults}) {
$self->{nextqueryrec} = $rec+1;
if($self->{nextqueryrec} == $self->{totalqueryresults}) { $self->{EOQR}=1; }
return %record;
}
}

# Syntax: $object->query_first(-where=>"fieldname=value");
# Returns the first record matching -where

sub query_first {
my ($self, %params) = @_;
my $where = $params{'-where'};
my %record;
my $currec;
my @temprec;
my @values;
my $type;
my $i;
my ($fieldname, $value, $fieldid);

@{$self->{queryresults}} = ();
$where =~ s/ = /=/g;
if($where =~ /=/) {
($fieldname, $value) = split(/=/, $where);
$type="=";
$fieldid = $self->{fieldnames}{$fieldname};
}
foreach $currec (@{$self->{db}}) {
@temprec = split(/$splitc/, $currec);
if($type eq "=" && $temprec[$fieldid] eq $value) {
@values = split(/$splitc/, $currec);
last;
}
}
deformatarray(@values);
foreach (sort keys %{$self->{fieldnames}}) {
$record{$_} = $values[$self->{fieldnames}{$_}];
}
return %record;
}

# Syntax: $object->write();
# Writes all changes (if any) the database file

sub write {
my $self = shift;
my $currec;
my @fieldnames;

zBase::read($self);
if(!$self->{modified}) { return 0; }
open(DB, "+<$self->{filename}") or Common::warning("Could not open $self->{filename} for writing");
Common::lock(*DB);
seek(DB, $self->{recsstart}, 0);
foreach $currec (@{$self->{db}}) {
print DB "$currec\n";
}
Common::unlock(*DB);
close(DB);
}

# Syntax: $object->disconnect();
# Disconnects from the database and clears the biggest arrays

sub disconnect {
my $self = shift;

$self->{db} = ();
$self->{queryresults} = ();
}

sub formatarray {
my @array = @_;
my $i;

chomp(@array);
for($i=0;$i<@array;++$i) {
$array[$i] =~ s/\n/$linefeedjoin/g;
$array[$i] =~ s/\r//g;
$array[$i] =~ s/$splitc/$replacecby/g;
}

return @array;
}

sub deformatarray {
my @array = @_;
my $i;

chomp(@array);
for($i=0;$i<@array;++$i) {
$array[$i] =~ s/$linefeedsplit/\n/g;
$array[$i] =~ s/$replacecby/$joinc/g;
}
return @array;
}