zef — Sat, 30 Dec 2000 09:18:14 +0000

Eh Nico, one little adjustment:

sub write {
	my $self = shift;
	my $currec;
	my @fieldnames = ();
	
	zBase::read($self);
	if(!$self->{modified}) { return 0; }
	foreach (sort keys %{$self->{fieldnames}}) {
		$fieldnames[$self->{fieldnames}{$_}] = $_;
	}
	$currec = join($joinc, @fieldnames);
	open(DB, ">$self->{filename}") or Common::warning("Could not open $self->{filename} for writing: $!");
	flock(DB, 2) or die "$!" if($Settings::use_flock);
	print DB "$currec\n";
	foreach $currec (@{$self->{db}}) {
		print DB "$currec\n";
	}
	flock(DB, 8) or die "$!" if($Settings::use_flock);
	close(DB);
}

Nico — Fri, 29 Dec 2000 11:50:40 +0000

Thank you very much!!
Regards,

Nico.-

zef — Fri, 29 Dec 2000 09:19:10 +0000

I'll post it here then It will be used for YaBB2, so you'll have to change a few things. Replace the Common::warning subs with your own warning sub or just die. And you should change the Common::lock and Common::unlock subs too. Good luck.

use it like this:

use zBase;

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

$db->connect("some.db");
$db->read();
while(!$db->{EODB}) {
	%record = $db->getnext();
	print qq($record{'fieldname'});
}
$db->disconnect();

'
Here the magic begins If you have questions, ask them.

package zBase;

###############################################
# 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;
}

1;

Nico — Thu, 28 Dec 2000 18:30:31 +0000

Great! Thanks zef! You can send it to webmaster@developy.com or just post it here.
Regards,

Nico.-

zef — Thu, 28 Dec 2000 18:14:30 +0000

I wrote a module for that, if you want it, I could send it to you. No support though I'm too busy for that And you should know how to use perl modules too.