Return to delRS.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/delRS.pl, revision 1.3

1.1       boris       1: #!/usr/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: delRS.pl - скрипт для удаления из дампа таблицы word2question
                      6: и таблицы соответствия идентификаторов 
                      7: информации о вопросах указанного файла (или тура).
                      8: 
                      9: =head1 SYNOPSIS
                     10: 
                     11: delRS.pl dump table name1 name2 name3 ...
                     12: 
                     13: delRS.pl dump table name.tur ...
                     14: 
                     15: 
                     16: 
                     17: =head1 AUTHOR
                     18: 
                     19: Роман Семизаров
                     20: 
                     21: 
                     22: =cut
                     23: 
                     24: use lib "../lib";
                     25: use dbchgk;
                     26: use chgkfiles;
                     27: 
                     28: if ($#ARGV<2)
                     29: {
                     30:    print "Usage: delRS.pl dump table name1 name2 name3 ...";
                     31:    exit;
                     32: }
                     33: 
                     34: my($dumpname, $tablename, @names)=@ARGV;
                     35: 
1.2       roma7      36: open (TABLE, $tablename) or die "0: Can not open ". $tablename;
1.1       boris      37: 
                     38: open (DUMP, $dumpname) or die "0: Can not open ". $dumpname;
                     39: 
                     40: binmode(DUMP);
                     41: 
                     42: open OUTDUMP, ">tmp1";
                     43: binmode(OUTDUMP);
                     44: 
                     45: open OUTTABLE, ">tmp2";
                     46: 
                     47: open STDERR, ">errors";
                     48: 
                     49: 
                     50: while (<TABLE>)
                     51: {
                     52: 
                     53:   ($in,$out)=split;
                     54:   if (grep $out=~m/^$_\./, @names) {
                     55:     mydo("Update Questions set ProcessedBySearch=NULL where QuestionId=$in")
                     56:   }
                     57:   else {
                     58:     write OUTTABLE;
                     59:     $outid{$in}=$out;
                     60:   }
                     61: }
                     62: 
                     63: 
                     64: print "getting and writing dump\n";
                     65: 
                     66: while (read(DUMP, $w,4))
                     67: {
                     68:    print "$sch...\n" unless (++$sch%100);
                     69:    read(DUMP,$l,4);
                     70:    $kvo=unpack("L",$l);
                     71:    read(DUMP,$q,$kvo);
                     72:    $q=~s/(.)(..)(.)/&s($1,$2,$3,\$kvo)/sge;
                     73: #$q=~s/(.)(..)(.)/$outid{unpack("L",$2)}?$1.$2.$3:''/sge;
                     74:    $l=pack("L",$kvo);
                     75:    print OUTDUMP $w,$l,$q;
                     76: }
                     77: 
                     78: 
                     79: 
                     80: close (DUMP);
                     81: close (OUTDUMP);
                     82: 
                     83: sub s
                     84: { 
                     85:    my ($s1,$s2,$s3,$kvo) = @_;
1.3     ! roma7      86:    $unpacked=unpack("S",$s2)|(($s1 & 0xF0) << 12);
1.1       boris      87:    my $id=$outid{$unpacked};
                     88:    if (!$id) {$$kvo-=4;return ""} else {return "$s1$s2$s3"}
                     89: 
                     90: #   $outid{unpack("L",$s2)} ? $s1.$s2.$s3:''
                     91: }
                     92: 
                     93: format OUTTABLE =
                     94: @<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                     95: $in, $out
                     96: .