Annotation of db/prgsrc/dump2dump.pl, revision 1.5

1.2       boris       1: #!/usr/local/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: dump2dump.pl - Скрипт для преобразования номеров вопросов в дампе, 
                      6: созданном скриптом dumpRS.pl, используя таблицы, созданные скриптом 
                      7: dumpin2out.pl. У обработанных вопросов устанавливает ProcessedBySearch=1
                      8: (loaddump уже не бует обладать этой информацией)
                      9: 
                     10: 
                     11: =head1 SYNOPSIS
                     12: 
                     13: dump2dump.pl input output oldtable newtable
                     14: 
                     15: 
                     16: =head1 AUTHOR
                     17: 
                     18: Роман Семизаров
                     19: 
                     20: 
                     21: =cut
                     22: 
1.3       boris      23:     use lib "../lib";
1.2       boris      24: use dbchgk;
                     25: 
                     26: open (T2, $ARGV[3]) or die "3: Can not open ". $ARGV[3];
                     27: 
                     28: open (OUTTABLE, ">d423JX2");
                     29: 
                     30: print "loading new table\n";
                     31: 
                     32: while (<T2>)
                     33: {
                     34:   ($id,$name)=split;
                     35:   $temp{$name}=$id;
                     36: }
                     37: 
                     38: print "loading old table\n";
                     39: open (T1, $ARGV[2]) or die "2: Can not open ". $ARGV[2];
                     40: 
                     41: while (<T1>)
                     42: {
                     43:   ($in,$out)=split;
                     44:   $id{$in}=$temp{$out};
                     45: }
                     46: 
                     47: #%temp=undef;
                     48: 
                     49: close(T1);
                     50: close(T2);
                     51: 
                     52: 
                     53: 
                     54: open (DUMP1, $ARGV[0]) or die "0: Can not open ". $ARGV[0];
                     55: binmode(DUMP1);
                     56: open (DUMP2, ">".$ARGV[1])  or die "1: Can not open ". $ARGV[1];
                     57: binmode(DUMP2);
                     58: 
                     59: print "getting and writing dump\n";
                     60: while (read(DUMP1, $w,4))
                     61: {
                     62:    print "$sch...\n" unless (++$sch%100);
                     63:    read(DUMP1,$l,4);
                     64:    read(DUMP1,$q,unpack("L",$l));
                     65:    $q=~s/(.)(..)(.)/$1.pack("S",$id{unpack("S",$2)}).$3/sge;
                     66: 
                     67:    print DUMP2 $w,$l,$q;
                     68: }
                     69: 
                     70: close (DUMP1);
                     71: close (DUMP2);
                     72: 
                     73: print "Setting ProcessedBySearch...\n";
                     74: 
                     75: 
1.3       boris      76: $sch=0;
1.2       boris      77: foreach my $id (values %id)
                     78: {
                     79:   print " $sch...\n" unless (++$sch%100);
                     80:   mydo("update Questions set ProcessedBySearch=1 where QuestionId=$id");
                     81: }
                     82: 
                     83: 
                     84: 
                     85: 
                     86: 
                     87: sub s
                     88: {
1.5     ! boris      89: #!!!! Ne doizmeneno!!!!!!!!!
1.2       boris      90:   my $a=shift;
1.4       roma7      91:   my $unpacked=unpack("L",$a);
                     92:   my $field=$unpacked && 0xF;
                     93:   $unpacked=$id{(($unpacked & 0xF0) << 12) + $unpacked & 0xFFFF};
1.5     ! boris      94: #  my $packed=$field | $unpacked & 0xF0) << 12) + $unpacked & 0xFFFF);
1.2       boris      95:   $packed;
                     96: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>