Re: çift kayıtları bulma

[Recai Oktaş <roktas@debian.org>]

Merhaba,

* Zeki Çatav [2006-07-03 20:11:48+0300]
> Bir veri dosyası (halen .dbf formatında ama gerekirse uygun başka
> formatlara da çevirilebilecek) içinde yer alan kayıtlardan (~ 1000 kayıt
> ve her kayda ait ~ 250 değişken) çift olanları seçip her kaydı tek hale
> getirebilecek bir yöntem için önerilerinizi bekliyorum. Çift kayıt
> kararını bir kayda ait tüm değişkenlere bakarak vermeli. Veya olanak
> dahilindeyse ben değişkenlerden seçim yapabilirim.
> Openoffice hesap çizelgesi ile yapabilir miyim diye baktım ama işe
> yarayacak bir seçenek göremedim. Eskiden excel içinde "find duplicate"
> benzeri komut ile bu tür bir seçenek vardı diye hatırlıyorum ama
> openoffice içinde de olmadığına göre yanlış hatırlıyor olmalıyım.

Zeki hocam, ekte hızlıca yazdığım bir perl betiği gönderiyorum.  CPAN'ı
biraz araştırdım (ne ararsanız var), DBase dosyalarını okuyan bir modül
mevcut: XBase ve Debian paketi de var bunun.  Önce bu paketi kurmalısınız:

    apt-get install libdbd-xbase-perl

Paketle birlikte dbf_dump adında bir araç geliyor, veritabanının metin
dökümünü alabiliyorsunuz (seçenekler için bk. dbf_dump(1)):

    dbf_dump foo.dbf >foo.txt

Ekteki betik, veritabanının yedeğini aldıktan sonra, seçtiğiniz bir alana
göre (sizin ifadenizle değişken) mükerrer kayıtları siliyor.  foo.dbf
dosyasındaki alanları görmek için:

    dbf_uniq.pl foo.dbf

Bu şekilde seçtiğiniz bir FOO alanına göre mükerrer kayıtları elemek için:

    dbf_uniq.pl foo.dbf FOO

Bir deneyin gerekirse kurcalamaya devam ederim.

-- 
roktas

#!/usr/bin/perl -CSD

use strict;
use warnings;
use encoding 'utf8';

use XBase; # apt-get install libdbd-xbase-perl
use List::Util qw(first);
use File::Copy;

my $file = shift @ARGV || die "Kullanım: $0 <DBase_dosyası> <Alan>\n";
my $uniq = shift @ARGV;

my $table = new XBase $file or die XBase->errstr;
my @field_names = $table->field_names;

my $is_valid;
if (defined $uniq) {
	$is_valid = length(first { $_ eq $uniq } @field_names or q{});
}

if ($is_valid) {
	copy($file, "$file.bak") or die "Yedekleme başarısız: $!\n";
	my %seen;
	RECORD: foreach my $nr (0 .. $table->last_record) {
		my ($deleted, $item) = $table->get_record($nr, $uniq);
		die $table->errstr if !defined $deleted;
		next RECORD if $deleted;
		$seen{$item} ? $table->delete_record($nr) : $seen{$item}++;
	}
} else {
	print STDERR "'$uniq' adında bir alan yok!  " if defined $uniq;
	print STDERR "Aşağıdaki alanlardan biri seçilmeli:\n@field_names\n";
}

$table->close;