Return to delRS.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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: 
        !            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: .