view release on metacpan or  search on metacpan

lib/DB_File/DB_Database.pm  view on Meta::CPAN

}
# ###############################################################################
sub get_record_hash {
	my ($self, $id) = @_;
	return unless ( $id = $self->check_for_select($id) );
	my @data = $self->get_record_nf($id) or return;
	my $hash = {};
	@{$hash}{ ('__ID', $self->field_names) } = @data;
	return %$hash if wantarray;
	$hash;
}
# ###############################################################################
sub get_record_nf {
	my ($self, $id, @fieldnums) = @_;
	return unless ( $id = $self->check_for_select($id) );
	my $data = $self->real_read_record($id) or return;
	return ($id, @$data) if (not @fieldnums);

	my @return_data = ($id);
	foreach ( @fieldnums ) {
		push (@return_data, @$data[$_] );
	}
	return @return_data;
}
# ###############################################################################
# Actually read the data 
sub real_read_record {
	my ($self, $id) = (shift, shift);
	return if (not $self->{'DataBase'}->{'db'}->{$id} );
	$self->csv_prase( $self->{'DataBase'}->{'db'}->{$id} );
}
# ###############################################################################
sub check_for_select {
	my ($self, $id) = @_;
	if ( not defined $id ) {
		$id = shift ( @{$self->{'Select'}->{'Result'}} );
		return undef if not defined $id;
	}
	$id;
}





# ###############################################################################
# Write record, values of the fields are in the argument list.
sub set_record {
	my ($self, $id, @data) = @_;
	$self->real_write_record($id, @data);
}
# ###############################################################################
# Write record, fields are specified as hash, unspecified are set to undef/empty
sub set_record_hash {
	my ($self, $id) = (shift,shift);
	my %data = $self->check_field_names_hash(@_);
	$self->set_record($id, map { $data{$_} } $self->field_names );
}
# ###############################################################################
# Write record, fields specified as hash, unspecified will be unchanged
sub update_record_hash {
	my ($self, $id) = ( shift, shift );
	my %olddata = $self->get_record_hash($id);
	return unless %olddata;
	$self->set_record_hash($id, %olddata, @_);
}
# ###############################################################################
# Write record, values of the fields are in the argument list.
sub append_record {
	my ($self, @data) = @_;
	$self->real_write_record(undef, @data);
}
# ###############################################################################
# Write record, fields are specified as hash, unspecified are set to undef/empty
sub append_record_hash {
	my $self = shift;
	my %data = $self->check_field_names_hash(@_);
	$self->append_record( map { $data{$_} } $self->field_names );
}
# ###############################################################################
# Actually write the data (@newdata = undef means delete record)
sub real_write_record {
	my ($self, $id) = (shift, shift);
	$id = $self->{'DataBase'}->{'LastRecord'}+1 if (not defined $id);
	my @newdata = @_;
	my $olddata;
	if ( $self->{'DataBase'}->{'rw'} ) {
		$olddata = $self->real_read_record($id) if (defined $self->{'DataBase'}->{'db'}->{$id});
		my ($tagname, $key);
		my ($oldindex,$newindex);
		while ( ($tagname,$key) = each (%{$self->{'Index'}}) ) {
#print "\nOldIndex: ";
			$oldindex = $self->get_index_string($tagname, $olddata);
#print "\nNewIndex: ";
			$newindex = $self->get_index_string($tagname, \@newdata);
#			$DB_BTREE->{'compare'} = $self->get_compare_sub('index' => $tagname);
			if ( not @newdata or $oldindex ne $newindex ) {
				$self->real_delete_index_record( $tagname, $oldindex, $id ) if (defined $self->{'DataBase'}->{'db'}->{$id});
				$self->real_insert_index_record( $tagname, $newindex, $id ) if ( @newdata );
			}
		}
		if ( scalar(@newdata) ) {
			$self->{'DataBase'}->{'db'}->{$id} = $self->csv_combine(@newdata);
			$self->{'DataBase'}->{'db'}->{'__Total_Records'} ++;
			if( int($id) > $self->{'DataBase'}->{'LastRecord'} ) {
				$self->{'DataBase'}->{'db'}->{'__Last_Record'} = int($id);
				$self->{'DataBase'}->{'LastRecord'} = int($id);
			}
		}else {
			return if (not defined $self->{'DataBase'}->{'db'}->{$id});
			delete $self->{'DataBase'}->{'db'}->{$id};
			$self->{'DataBase'}->{'db'}->{'__Total_Records'} --;
		}
	}else {
		$self->Error("Writing Record Failed: File is opened only for reading.\n");
		return;
	}
	$id;
}

# ###############################################################################