
=head1 NAME

XBase::Base - Base input output module for XBase suite

=cut

package XBase::Base;

use strict;
use IO::File;

use vars qw( $VERSION $DEBUG $errstr );

$VERSION = '0.060';

# Sets the debug level
$DEBUG = 0;
sub DEBUG () { $DEBUG };

# Holds the text of the global error, if there was one
$errstr = '';
# Fetch the error message
sub errstr ()	{ ( ref $_[0] ? $_[0]->{'errstr'} : $errstr ); }

# Set errstr and print error on STDERR if there is debug level
sub Error (@)
	{
	my $self = shift;
	( ref $self ? $self->{'errstr'} : $errstr ) = join '', @_;
	}
# Null the errstr
sub NullError
	{ shift->Error(''); }


# Build the object in the memory, open the file
sub new
	{
	__PACKAGE__->NullError();
	my $class = shift;
	my $new = bless {}, $class;
	if (@_ and not $new->open(@_)) { return; }
	return $new;
	}
# Open the specified file. Use the read_header to load the header data
sub open
	{
	__PACKAGE__->NullError();
	my ($self, $filename) = (shift, shift);
	if (defined $self->{'fh'}) { $self->close(); }

	my $fh = new IO::File;
	my $rw;
	if ($fh->open($filename, 'r+'))		{ $rw = 1; }
	elsif ($fh->open($filename, 'r'))	{ $rw = 0; }
	else { __PACKAGE__->Error("Error opening file $filename: $!\n"); return; }
	binmode($fh);
	@{$self}{ qw( fh filename rw ) } = ($fh, $filename, $rw);
	## $self->locksh();

		# read_header should be defined in the derived class
	$self->read_header(@_);
	}
# Close the file
sub close
	{
	my $self = shift;
	$self->NullError();
	if (not defined $self->{'fh'})
		{ $self->Error("Can't close file that is not opened\n"); return; }
	$self->{'fh'}->close();
	delete $self->{'fh'};
	1;
	}
# Drop (unlink) the file
sub drop
	{
	my $self = shift;
	$self->NullError();
	if (defined $self->{'filename'})
		{
		my $filename = $self->{'filename'};
		$self->close() if defined $self->{'fh'};
		if (not unlink $filename)
			{ $self->Error("Error unlinking file $filename: $!\n"); return; };
		}
	1;	
	}
# Create new file
sub create_file
	{
	my $self = shift;
	my ($filename, $perms) = @_;
	if (not defined $filename)
		{ __PACKAGE__->Error("Name has to be specified when creating new file\n"); return; }
	if (-f $filename)
		{ __PACKAGE__->Error("File $filename already exists\n"); return; }

	$perms = 0644 unless defined $perms;
	my $fh = new IO::File;
	$fh->open($filename, 'w+', $perms) or return;
	binmode($fh);
	@{$self}{ qw( fh filename rw ) } = ($fh, $filename, 1);
	return $self;
	}


# Compute the offset of the record
sub get_record_offset
	{
	my ($self, $num) = @_;
	my ($header_len, $record_len) = ($self->{'header_len'},
						$self->{'record_len'});
	unless (defined $header_len and defined $record_len)
		{ $self->Error("Header and record lengths not known in get_record_offset\n"); return; }
	unless (defined $num)
		{ $self->Error("Number of the record must be specified in get_record_offset\n"); return; }
	return $header_len + $num * $record_len;
	}


# Seek to start of the record
sub seek_to_record
	{
	my ($self, $num) = @_;
	defined (my $offset = $self->get_record_offset($num)) or return;
	$self->seek_to($offset);
	}
# Seek to absolute position
sub seek_to
	{
	my ($self, $offset) = @_;
	unless (defined $self->{'fh'})
		{ $self->Error("Cannot seek on unopened file\n"); return; }
	unless ($self->{'fh'}->seek($offset, 0))
		{ $self->Error("Seek error (file $self->{'filename'}, offset $offset): $!\n"); return; };
	1;
	}


# Read the record of given number. The second parameter is the length of
# the record to read. It can be undefined, meaning read the whole record,
# and it can be negative, meaning at most the length
sub read_record
	{
	my ($self, $num, $in_length) = @_;
	if ($num > $self->last_record)
		{ $self->Error("Can't read record $num, there is not so many of them\n"); return; }
	if (not defined $in_length)
		{ $in_length = $self->{'record_len'}; }
	if ($in_length < 0)
		{ $in_length = -$self->{'record_len'}; }

	defined (my $offset = $self->get_record_offset($num)) or return;
	$self->read_from($offset, $in_length);
	}
sub read_from
	{
	my ($self, $offset, $in_length) = @_;
	unless (defined $offset)
		{ $self->Error("Offset to read from must be specified\n"); return; }
	$self->seek_to($offset) or return;
	my $length = $in_length;
	$length = -$length if $length < 0;
	my $buffer;
	my $read = $self->{'fh'}->read($buffer, $length);
	if (not defined $read or ($in_length > 0 and $read != $in_length))
		{ $self->Error("Error reading $in_length bytes from $self->{'filename'}\n"); return; }
	$buffer;
	}


# Write the given record
sub write_record
	{
	my ($self, $num) = (shift, shift);
	defined (my $offset = $self->get_record_offset($num)) or return;
	defined $self->write_to($offset, @_) or return;
	$num == 0 ? '0E0' : $num;
	}
# Write data directly to offset
sub write_to
	{
	my ($self, $offset) = (shift, shift);
	if (not $self->{'rw'})
		{ $self->Error("The file $self->{'filename'} is not writable\n"); return; }
	$self->seek_to($offset) or return;
	local ($,, $\) = ('', '');
	$self->{'fh'}->print(@_) or
		do { $self->Error("Error writing to offset $offset in file $self->{'filename'}: $!\n"); return; } ;
	$offset == 0 ? '0E0' : $offset;
	}


sub locksh	{ _locksh(shift->{'fh'}) }
sub lockex	{ _lockex(shift->{'fh'}) }
sub unlock	{ _unlock(shift->{'fh'}) }

sub _locksh	{ flock(shift, 1); }
sub _lockex	{ flock(shift, 2); }
sub _unlockex	{ flock(shift, 8); }


1;

__END__

=head1 SYNOPSIS

Used indirectly, via XBase or XBase::Memo.

=head1 DESCRIPTION

This module provides catch-all I/O methods for other XBase classes,
should be used by people creating additional XBase classes/methods.
There is nothing interesting in here for users of the XBase(3) module.
Methods in XBase::Base return nothing (undef) on error and the error
message can be retrieved using the B<errstr> method.

Methods are:

=over 4

=item new

Constructor. Creates the object and if the file name is specified,
opens the file.

=item open

Opens the file and using method read_header reads the header and sets
the object's data structure. The read_header should be defined in the
derived class, there is no default.

=item close

Closes the file, doesn't destroy the object.

=item drop

Unlinks the file.

=item create_file

Creates file of given name. Second (optional) paramater is the
permission specification for the file.

=back

The reading/writing methods assume that the file has got header of
length header_len bytes (possibly 0) and then records of length
record_len. These two values should be set by the read_header method.

=over 4

=item seek_to, seek_to_record

Seeks to absolute position or to the start of the record.

=item read_record, read_from

Reads data from specified position (offset) or from the given record.
The second parameter (optional for B<read_record>) is the length to
read. It can be negative, and at that case the read will not complain
if the file is shorter than requested.

=item write_to, write_record

Writes data to the absolute position or to specified record position.
The data is not padded to record_len, just written out.

=back

General locking methods are B<locksh>, B<lockex> and B<unlock>, they
call B<_locksh>, B<_lockex> and B<_unlock> which can be redefined to
allow any way for locking (not only the default flock). The user is
responsible for calling the lock if he needs it.

No more description -- check the source code if you need to know more.

=head1 VERSION

0.060

=head1 AUTHOR

(c) 1997--1998 Jan Pazdziora, adelton@fi.muni.cz

=head1 SEE ALSO

perl(1), XBase(3)

