Return to delRS.pl CVS log

Up to [Local Repository] / db / prgsrc

Trying to fix bug-65536

#!/usr/bin/perl -w

=head1 NAME

delRS.pl - скрипт для удаления из дампа таблицы word2question
и таблицы соответствия идентификаторов 
информации о вопросах указанного файла (или тура).

=head1 SYNOPSIS

delRS.pl dump table name1 name2 name3 ...

delRS.pl dump table name.tur ...



=head1 AUTHOR

Роман Семизаров


=cut

use lib "../lib";
use dbchgk;
use chgkfiles;

if ($#ARGV<2)
{
   print "Usage: delRS.pl dump table name1 name2 name3 ...";
   exit;
}

my($dumpname, $tablename, @names)=@ARGV;

open (TABLE, $tablename) or die "0: Can not open ". $tablename;

open (DUMP, $dumpname) or die "0: Can not open ". $dumpname;

binmode(DUMP);

open OUTDUMP, ">tmp1";
binmode(OUTDUMP);

open OUTTABLE, ">tmp2";

open STDERR, ">errors";


while (<TABLE>)
{

  ($in,$out)=split;
  if (grep $out=~m/^$_\./, @names) {
    mydo("Update Questions set ProcessedBySearch=NULL where QuestionId=$in")
  }
  else {
    write OUTTABLE;
    $outid{$in}=$out;
  }
}


print "getting and writing dump\n";

while (read(DUMP, $w,4))
{
   print "$sch...\n" unless (++$sch%100);
   read(DUMP,$l,4);
   $kvo=unpack("L",$l);
   read(DUMP,$q,$kvo);
   $q=~s/(.)(..)(.)/&s($1,$2,$3,\$kvo)/sge;
#$q=~s/(.)(..)(.)/$outid{unpack("L",$2)}?$1.$2.$3:''/sge;
   $l=pack("L",$kvo);
   print OUTDUMP $w,$l,$q;
}



close (DUMP);
close (OUTDUMP);

sub s
{ 
   my ($s1,$s2,$s3,$kvo) = @_;
   $unpacked=unpack("S",$s2)|(($s1 & 0xF0) << 12);
   my $id=$outid{$unpacked};
   if (!$id) {$$kvo-=4;return ""} else {return "$s1$s2$s3"}

#   $outid{unpack("L",$s2)} ? $s1.$s2.$s3:''
}

format OUTTABLE =
@<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$in, $out
.