* 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 ([EMAIL PROTECTED]) { 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;