Re: çift kayıtları bulma

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

* Zeki Çatav [2006-07-04 10:32:05+0300]
> Sal, 2006-07-04 tarihinde 02:38 +0300 saatinde, Recai Oktaş yazdı:
> > Zeki hocam, ekte hızlıca yazdığım bir perl betiği gönderiyorum.  CPAN'ı
[...]
> Bu betik çalıştı. Seçilen değişkene göre ayıklama işlemini başarıyla
> yapabildi. Ancak birşey daha sormak istiyorum. Seçilen değişken bir

Ektekini deneyelim.  XBase modülünde bu işi daha zarif yapmanın bir yolu
vardır belki, ama bildiğimiz taraftan gitmek daha kestirme geldi.  Yeni
haliyle şöyle kullanacaksınız:

    # alan adları ve sütun noları görüntüler
    ./dbf_uniq.pl foo.dbf
    # 3-5 ve 9 sütunları ve FOO ile BAR arası kayıtları işler
    ./dbf_uniq.pl foo.dbf 3-5 FOO-BAR 9

-- 
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 $xbase_file = shift @ARGV
    || die "Kullanım: $0 <DBase_dosyası> <Alan aralığı>...\n\n",
           "   Örnek: $0 foo.dbf ISIM 3-5 CINSIYET-SEHIR\n",
           "          Alan adı ve sütun listesi için '$0 foo.dbf'\n";

my $xbase_table = new XBase $xbase_file or die XBase->errstr;
my @xbase_fields = $xbase_table->field_names;
my %xbase_map; {
	my $col;
	map { $xbase_map{$_} = ++$col } @xbase_fields;
}

sub valid_field_column {
	my $field = shift || return @xbase_map{$xbase_fields[0]};

	if ($field =~ m/^\d+$/) {
		return (scalar($field) <= @xbase_fields) ? scalar($field) : @xbase_fields;
	} else {
		return $xbase_map{$field} if exists $xbase_map{$field};
		die "Bozuk alan tanımlaması: '$field'\n";
	}
}

if (!@ARGV) {
	print "== [INDEKS] ALAN_ADI ==\n";
	while (my ($k, $v) = each %xbase_map) {
		print "[$v] $k    ";
	}
	print "\n";
	exit 0;
}

my @targets;
foreach (@ARGV) {
	my ($start, $stop) = split /-/;
	($start, $stop) = sort { $a <=> $b } (
	    valid_field_column($start),
	    valid_field_column($stop)
	);

	push @targets, { start => $start, stop => $stop	};
}

copy($xbase_file, "$xbase_file.bak") or die "Yedekleme başarısız: $!\n";

foreach my $t (@targets) {
	TARGET: foreach my $col ($t->{start} .. $t->{stop}) {
		my $field_name = $xbase_fields[$col];
		next TARGET if $xbase_map{$field_name} < 0;

		my %seen;
		RECORD: foreach my $nr (0 .. $xbase_table->last_record) {
			my ($deleted, $item) = $xbase_table->get_record($nr, $field_name);
			die $xbase_table->errstr if !defined $deleted;
			next RECORD if $deleted;
			$seen{$item} ? $xbase_table->delete_record($nr) : $seen{$item}++;
		}
		$xbase_map{$field_name} = -1;
	}
}

$xbase_table->close;