Return to delRS.pl CVS log | Up to [Local Repository] / db / prgsrc |
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) = @_;
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: .