Return to delRS.pl CVS log

Up to [Local Repository] / db / prgsrc

add delRS

    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: 
   36: open (TABLE, $tablename) or die "0: Can not open ". $tablenamename;
   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) = @_;
   86:    $unpacked=unpack("S",$s2);
   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: .