/usr/local/CPAN/CDB_Perl/CDB_Perl/Write.pm

• package CDB_Perl::Write
  • new
  • insert
  • finish
  • write_table
  • write_long
  • write
  • TIEHASH
  • FETCH
  • STORE
  • UNTIE
  • DELETE
  • DESTROY
• EOF

package CDB_Perl::Write;

use Carp qw(carp croak);

require CDB_Perl;
@ISA = qw(CDB_Perl);

use strict;
#use warnings;

sub new{
	my $pack = shift;
	my $fname = shift or croak "$pack->new(filename); filename not defined";

	my $self =  bless{}, $pack;
	$self->file_open($fname, '>');
	$self->{'table'}=[];
	$self->seek(2048);
	return $self;
}

sub insert{
	my ($self, $k,$v) = @_;

	if($self->{'finished'}){
		croak "Trying to insert values into a finished CDB."
	}else{
		my $table = $self->{'table'};
		my $pos = $self->{'pos'};

		if(!defined($k)){
			croak "insert must be called with 'key', 'value' as arguments. Key not defined.";
		}
		my $klen = length($k);
		my $vlen = length($v);
		my ($h, $h0,$h1) = $self->hash($k);

		if(!$table->[$h0]){
			$table->[$h0] = [];
		}

		push @{$table->[$h0]},($h,$pos);

		$self->write_long($klen,$vlen);
		$self->write($k.$v,$klen+$vlen);

		return $self;
	}
}

sub finish{
	my $self = shift;
	if($self->{'finished'}){
		croak("Trying to finish an already finished CDB.");
	}else{
		my $table = $self->{'table'};
		my $pos = $self->{'pos'};
		my $init = $pos;

		my @head;

		for my $n (0..255){
			my $t = $table->[$n];
			my $len = 0;
			if($t && @$t){
				$len = @$t;
				$pos = $self->{'pos'};
				$self->write_table($n);
			}
			push @head,($pos,$len);
		}
		$self->seek(0);
		$self->write_long(@head);
		$self->seek($init);
		$self->{'finished'} = 1;
		return $self;
	}
}

sub write_table{
	my ($self, $n) = @_;
	die unless defined($n);

	my $table = $self->{'table'}->[$n];
	my $len = @$table;
	
	my @tmp;
	#init table
	$#tmp = $len*2-1;
	for(0 .. $len*2-1){
		$tmp[$_] = 0;
	}

	for my $i (0..$len/2-1){
		my $hash = $table->[$i*2];
		my $pos  = $table->[$i*2 + 1];
		
		my $h = ($hash>>8) % $len;

		#find next free slot;
		my $ii= $h*2;
		while($tmp[$ii+1] != 0){
			$ii = ($ii + 2) % (2*$len);
		}
		@tmp[$ii,$ii+1] = ($hash,$pos);
	}
	
	$self->write_long(@tmp);
	return $self;
}

sub write_long{
	my $self = shift;
	my @data = @_;

	my $t = pack("V".(scalar @data),@data);
	$self->write($t,4*@data);
	return $self;
}

sub write{
	my $self = shift;
	my($data, $len) = @_;

	my $file = $self->{'file'};
	if(!print $file $data){
		croak("IO error $!");
	}

	if(!defined ($len)){
		$len = length($data);
	}
	$self->{'pos'}+=$len;
	return $self;
}

sub TIEHASH{
	my $pack = shift;
	return $pack->new(@_);
}

sub FETCH{
	my ($self, $key) = @_;
	return;
	croak "Can't read data on an CDB writer $key";
}

sub STORE{
	my ($self, $key, $value) = @_;
	return $self->insert($key, $value);
}

sub UNTIE{
	shift->finish;
}

sub DELETE{
	croak "Can't remove values once inserted";
}

sub DESTROY{
	my $self = shift;
	if(!$self->{'finished'}){
		$self->finish;
	}
	close($self->{'file'}) or croak "Error closing CDB file.\n$!";
}

1;