Annotation of db/prgsrc/updatedb.pl, revision 1.45

1.1       boris       1: #!/usr/local/bin/perl 
                      2: 
                      3: =head1 NAME
                      4: 
                      5: updatedb.pl - a script for creation of new database. 
                      6: 
                      7: =head1 SYNOPSIS
                      8: 
1.25      roma7       9: updatedb.pl B<[-i]> I<file1> I<file2>....
1.1       boris      10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
                     14: Updates information in the B<chgk> databse. Uses file
                     15: 
1.25      roma7      16: =head1 OPTIONS
                     17: 
                     18: =item B<-i> 
                     19: 
                     20: Ask about ParentId. 
                     21: 
1.1       boris      22: 
                     23: =head1 BUGS
                     24: 
                     25: The database, user and password are hardcoded. 
                     26: 
                     27: =head1 AUTHOR
                     28: 
                     29: Dmitry Rubinstein
                     30: 
1.44      roma7      31: =head1 $Id: updatedb.pl,v 1.43 2008-11-14 11:23:03 roma7 Exp $
1.1       boris      32: 
                     33: =cut
                     34: 
1.25      roma7      35: use vars qw($opt_i);
                     36: 
                     37: use Getopt::Std;
1.34      roma7      38: my $unsortedname="../dump/unsorted";
1.25      roma7      39: getopts('i');
1.29      roma7      40: #open STDERR, ">errors";
1.25      roma7      41: my $Interactive=$opt_i || 0;
1.31      boris      42: my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
1.25      roma7      43: 
1.1       boris      44: my (%RevMonths) = 
1.5       boris      45:     ('Jan', '1', 'Feb', '2', 'Mar', '3', 'Apr', '4', 'May', '5', 'Jun', '6',
                     46:      'Jul', '7', 'Aug', '8', 'Sep', '9', 'Oct', '10', 'Nov', '11',
                     47:      'Dec', '12', 
                     48:      'JAN', '1', 'FEB', '2', 'MAR', '3', 'APR', '4', 'MAY', '5', 'JUN', '6',
                     49:      'JUL', '7', 'AUG', '8', 'SEP', '9', 'OCT', '10', 'NOV', '11',
                     50:      'DEC', '12', 
1.13      boris      51:      'Янв', '1', 'Фев', '2', 'Мар', '3', 'Апр', '4', 'Май', '5',
                     52:      'Июн', '6', 'Июл', '7', 'Авг', '8', 'Сен', '9', 
                     53:      'Окт', '10', 'Ноя', '11', 'Дек', '12');
1.1       boris      54: my ($sth);
                     55: 
1.13      boris      56: 
1.3       boris      57: 
1.4       boris      58: 
1.3       boris      59: 
1.1       boris      60: use DBI;
                     61: use strict;
1.28      roma7      62: my $isunsorted=0;
1.1       boris      63: sub UpdateParents {
1.36      roma7      64:     my ($dbh, $ParentId, $all_qnum,$CreatedAt) = @_;
1.5       boris      65:     if ($ParentId) {
1.45    ! roma7      66:   my ($sth1) = $dbh->prepare("SELECT QuestionsNum, ParentId, CreatedAt
1.5       boris      67: FROM Tournaments WHERE Id = $ParentId");
1.45    ! roma7      68:   $sth1->execute;
        !            69:   my ($q, $p,$c) = ($sth1->fetchrow)[0, 1, 2];
        !            70:   $c=$CreatedAt if $CreatedAt && ($CreatedAt gt $c);
        !            71:   my $qc=$dbh->quote($c);
        !            72:   $dbh->do("UPDATE Tournaments SET 
1.36      roma7      73:                   QuestionsNum=$q + $all_qnum, CreatedAt=$qc
1.5       boris      74:                   WHERE Id = $ParentId");
1.45    ! roma7      75:   &UpdateParents($dbh, $p, $all_qnum,$c);
1.5       boris      76:     }
1.1       boris      77: }
                     78: 
1.36      roma7      79: 
1.1       boris      80: sub getField {
1.5       boris      81:     my($desc, $dbh) = @_;
                     82:     my($key);
                     83:     my($value) = ('');
                     84:     while (<$desc>) {
1.45    ! roma7      85:   s/[
]//g;
        !            86:   if ($key && /^\s*$/) {
        !            87:       chomp $value;
1.24      roma7      88:             $value =~ s/\s+$//;
1.45    ! roma7      89:       chomp $key;
        !            90:       if ($key eq 'Дата') {
        !            91:     $value =~ s/^(.*)-(.*)-(.*)$/$3-$2-$1/;
        !            92:     my($month) = $RevMonths{$2} || '01';
        !            93:     $value =~ s/-(.*)-/-$month-/;
        !            94:     $value =~ s/-00*$/-01/;
        !            95:       }
        !            96:       if ($key eq 'Автор') {$value=~s/\.$//;}
        !            97:       $value = $dbh->quote($value);
        !            98:       return ($key, $value);
        !            99:   }
        !           100:   next if (/^\s*$/);
        !           101:   
        !           102:   if (!$key && /^(.*?)[:\.]\s*(.*)$/s) {
        !           103:       $key = $1;
        !           104:       $value=$2;
        !           105:       next;
        !           106:   }
        !           107:   if ($key) {
        !           108:       $value .= $_;
        !           109:       next;
        !           110:   }
1.5       boris     111:     }
                    112:     if ($key && $value) {
1.23      roma7     113:         $value=~s/\s+$//;
1.45    ! roma7     114:   $value = $dbh->quote($value);
        !           115:   return ($key, $value);
1.5       boris     116:     }
                    117:     return (0, 0);
1.1       boris     118: }
                    119: 
                    120: sub SelectGroup {
1.7       boris     121:     my ($dbh, $source, $TourName) = @_;
                    122:     my ($sth, $ParentId, $i, @arr);
1.25      roma7     123: 
                    124:     if ($Interactive) {    
1.45    ! roma7     125:       $sth = $dbh->prepare("SELECT Id, Title FROM
        !           126:     Tournaments WHERE Type = 'Г'");
        !           127:       $sth->execute;
        !           128:       print "Выберите группу для турнира:\n$TourName, файл $source\n\n";
        !           129:       while (@arr=$sth->fetchrow) {
        !           130:     print "[$arr[0]] $arr[1]\n";
        !           131:       }
        !           132:       $ParentId = <STDIN>;
        !           133:       chomp $ParentId;
        !           134:       if (!$ParentId) {
        !           135:     print "Пропускаем файл $source\n";
        !           136:     print STDERR "Файл $source отвергнут оператором\n";
        !           137:     return (0,0);
        !           138:       } else {
        !           139:     print "Вы выбрали турнир: $ParentId\n";
        !           140:     $sth = $dbh->prepare("INSERT INTO Tournaments
        !           141:             (Title, Type, ParentId, FileName) 
        !           142:              VALUES ($TourName, 'Ч', $ParentId, 
1.25      roma7     143:                                        $source)");
1.45    ! roma7     144:     $sth->execute;
        !           145:     my $TournamentId = $sth->{mysql_insertid};
        !           146:     return ($TournamentId,$ParentId);
        !           147:   }
1.7       boris     148:     } else {
1.25      roma7     149: # Теперь, если файла нет в дереве турниров, никаких вопросов не 
                    150: # задаётся, а вместо этого он добавляется в группу 9999
1.45    ! roma7     151:     $ParentId = 9999;
        !           152:     my $tempsource=$source;
        !           153:     my $temptname=$TourName;
1.33      roma7     154:                 $tempsource=~s/^\'(.*)\'$/$1/;
                    155:                 $temptname=~s/^\'(.*)\'$/$1/;
1.45    ! roma7     156:       print UNSORTED "$tempsource".((12 -length($source))x' ')."\t$temptname\n";
        !           157:     $isunsorted=1;
        !           158:     $sth = $dbh->prepare("INSERT INTO Tournaments
        !           159:             (Title, Type, ParentId, FileName,CreatedAt) 
        !           160:              VALUES ($TourName, 'Ч', $ParentId, 
1.43      roma7     161:                                        $source,NOW())");
1.25      roma7     162:                 $sth->execute;
1.45    ! roma7     163:     my $TournamentId = $sth->{mysql_insertid};
        !           164:     return ($TournamentId,$ParentId);
        !           165:   }
        !           166:     
1.7       boris     167:     
1.1       boris     168: }
                    169: 
                    170: sub UpdateTournament {
1.5       boris     171:     my ($dbh, $TournamentId, $field, $value) = @_;
1.45    ! roma7     172:     $dbh->do("UPDATE Tournaments SET $field=$value WHERE Id=$TournamentId")
        !           173:   or die $dbh->errstr;
1.1       boris     174: }
                    175: 
                    176: sub UpdateQuestion {
1.5       boris     177:     my ($dbh, $QuestionId, $field, $value) = @_;
1.40      boris     178:     
1.45    ! roma7     179:     if (($field eq 'Type') && ($value eq "'Д'")) {
        !           180:          $value = "'ЧД'";
1.40      boris     181:     }
1.45    ! roma7     182:     $dbh->do("UPDATE Questions SET $field=$value 
        !           183:     WHERE QuestionId=$QuestionId")
        !           184:   or die $dbh->errstr;
1.1       boris     185: }
                    186: 
1.7       boris     187: sub CheckFile {
1.10      boris     188:     my ($dbh, $source, $title) = @_;
1.7       boris     189:     my $sth = $dbh->prepare("SELECT Id,ParentId,QuestionsNum FROM Tournaments
1.45    ! roma7     190:                              WHERE FileName=$source AND Type='Ч'");
        !           191:     $sth->execute or die $dbh->errstr;
1.7       boris     192:     my @arr = $sth->fetchrow;
                    193:     if (! scalar @arr) {
1.45    ! roma7     194:   return SelectGroup($dbh,$source,$title);
1.7       boris     195:     }
                    196:     my($Id,$ParentId,$QuestionsNum)=@arr;
1.45    ! roma7     197:     if($QuestionsNum) { 
        !           198:   print "Файл $source с данными $title уже существует. ",
        !           199:   "Заменить?[y/N]\n";
        !           200:   my $answer = <STDIN>;
        !           201:   if ($answer !~ /^[yY]/) {
        !           202:       return (0,0);
        !           203:   } else {
        !           204:       DeleteTournament($dbh,$Id,$ParentId,$QuestionsNum,0);
        !           205:   }
1.7       boris     206:     } 
1.45    ! roma7     207:     return($Id,$ParentId);  
1.7       boris     208: }
                    209: 
                    210: 
                    211: sub DeleteTournament {
1.10      boris     212:     my ($dbh,$Id,$ParentId,$QuestionsNum,$DeleteMyself) = @_;
                    213:     if ($QuestionsNum) {
1.45    ! roma7     214:   UpdateParents($dbh,$ParentId,-$QuestionsNum);
1.10      boris     215:     }
1.7       boris     216:     my (@Tours) = &GetTours($dbh, $Id);
                    217:     foreach my $Tour (@Tours) {
1.45    ! roma7     218:   DeleteTournament($dbh,$Tour,$Id,0,1);
1.7       boris     219:     }
                    220:     my $sth = $dbh->prepare("DELETE FROM Questions
                    221:                              WHERE ParentId=$Id");
                    222:     $sth->execute or die $dbh->errstr;
                    223:     if($DeleteMyself) {
1.45    ! roma7     224:   $sth = $dbh->prepare("DELETE FROM Tournaments
1.7       boris     225:                              WHERE Id=$Id");
1.45    ! roma7     226:   $sth->execute or die $dbh->errstr;
1.7       boris     227:     }
                    228: }
1.8       boris     229: 
                    230: sub GetTours {
1.45    ! roma7     231:   my ($dbh, $ParentId) = @_;
        !           232:   my (@arr, @Tours);
1.8       boris     233: 
1.45    ! roma7     234:   my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
        !           235:     WHERE ParentId=$ParentId ORDER BY Id");
1.8       boris     236: 
1.45    ! roma7     237:   $sth->execute;
1.8       boris     238: 
1.45    ! roma7     239:   while (@arr = $sth->fetchrow) {
        !           240:     push @Tours, $arr[0];
        !           241:   }
1.8       boris     242: 
1.45    ! roma7     243:   return @Tours;
1.8       boris     244: }
                    245: 
1.13      boris     246: sub CreateTour {
1.45    ! roma7     247:     my ($dbh,$title,$ParentId,$TourNum,$rh_defaults)=@_;
1.13      boris     248:     my $sth = $dbh->prepare("INSERT INTO Tournaments
1.45    ! roma7     249:            (Title, Type, ParentId, Number,CreatedAt) 
        !           250:            VALUES ($title, 'Т', $ParentId, $TourNum,NOW())");
        !           251:     $sth->execute;
1.13      boris     252:     my $TourId = $sth->{mysql_insertid};
                    253:     while (my ($key,$value)=each %$rh_defaults) {
1.45    ! roma7     254:   &UpdateTournament($dbh, $TourId, $key, $value);
1.13      boris     255:     }
                    256:     return $TourId;
                    257: }
1.45    ! roma7     258:     
1.8       boris     259: 
1.1       boris     260: MAIN: 
                    261: {
1.5       boris     262:     my($key, $value, $addition);
1.13      boris     263:     #
                    264:     # Inherited fields for a Tour or Tournament
                    265:     #
                    266:     my %TourFields = ('Копирайт' => 'Copyright',
1.45    ! roma7     267:           'Инфо' => 'Info', 'URL' => 'URL',
        !           268:           'Ссылка' => 'URL', 'Редактор' => 'Editors',
        !           269:           'Обработан'=> 'EnteredBy',
        !           270:           'Дата'=>'PlayedAt');
1.13      boris     271:     #
                    272:     # Inherited fields for a Question
                    273:     #
                    274:     my %QuestionFields = ('Тип'=> 'Type', 'Вид'=> 'Type', 
1.45    ! roma7     275:         'Автор' => 'Authors', 'Рейтинг'=>'Rating', 
        !           276:         'Источник' => 'Sources',
        !           277:         'Тема' => 'Topic');
        !           278:         
        !           279:           
1.5       boris     280:     my($source);
                    281:     
                    282:     my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
1.45    ! roma7     283:   or die "Can't connect to DB chgk\n";
1.42      roma7     284: if ($dbh->get_info( 18 )=~/^(5|(4.1))/)  {$dbh->do("SET NAMES 'koi8r'");}
1.45    ! roma7     285:     my @sources;  
1.34      roma7     286:     open UNSORTED, ">$unsortedname";
1.5       boris     287:     while ($source = shift) {
1.25      roma7     288:        push @sources,glob($source);
                    289:     }
                    290:     foreach $source(@sources) {
1.45    ! roma7     291:   my $TourNum=0;
        !           292:   my($PlayedAt) = '';
        !           293:   my($QuestionId, $TourId, $TournamentId, $ParentId) = (0, 0, 0, 0);
        !           294:   my($tournum, $qnum, $all_qnum) = (0, 0, 0);
        !           295:   my (@d) = (localtime((stat($source))[9]))[5,4,3];
        !           296:   $d[1]++;
        !           297:   $d[1]=sprintf("%02d",$d[1]);
        !           298:   $d[2]=sprintf("%02d",$d[2]);
        !           299:   $d[0]+=1900;
        !           300:   my $UnquotedCreated=join('-', @d);
        !           301:   my ($CreatedAt) = $dbh->quote($UnquotedCreated);
        !           302: 
        !           303:   open INFD, $source 
        !           304:       or die "Can't open input file: $!\n";
        !           305:   
        !           306:   $source =~ s/^.*\/([^\/]*)$/$1/;
        !           307:   my $unquotedsource=$source;
        !           308:   $unquotedsource=~s/\.txt\s*$//;
        !           309:   $source = $dbh->quote($source);
        !           310:   print STDERR "Файл: $source, дата: $CreatedAt ";
        !           311:   my %TourDefaults=('CreatedAt'=>$CreatedAt);
        !           312:   my %QuestionDefaults=();
        !           313:   my %QuestionGlobalDefaults=('Type'=>$dbh->quote('Ч'));
        !           314:   while (($key, $value) = getField(\*INFD, $dbh)) {
        !           315:       last if (!$key);
        !           316:       
        !           317:       if ($key =~ /Мета/) {
        !           318:     next;   # This is obsolete
        !           319:       }
        !           320:       if ($key =~ /Чемпионат/ || $key =~ /Пакет/) {   
        !           321:     ($TournamentId, $ParentId) = CheckFile($dbh,$source,$value);
        !           322:     if (!$TournamentId)  {
        !           323:         last;
        !           324:     } 
        !           325:     $sth = $dbh->prepare("UPDATE Tournaments SET
        !           326:                    Title=$value, Type='Ч', 
        !           327:                                      ParentId=$ParentId, 
        !           328:                                      FileName=$source, 
        !           329:                                      CreatedAt=$CreatedAt
1.7       boris     330:                                      WHERE
1.45    ! roma7     331:                                      Id=$TournamentId");
        !           332:     $sth->execute;
        !           333:     next;
        !           334:       }
        !           335:       if ($key =~ /Тур/) {
        !           336:     if ($TourId) {
        !           337: 
        !           338:           $dbh->do("UPDATE Tournaments SET QuestionsNum=$qnum
        !           339:             WHERE Id=$TourId");
        !           340:     }
        !           341:     $qnum = 0;
        !           342:     $TourNum++;
        !           343:     $TourDefaults{'FileName'}=$dbh->quote(
        !           344:                               "$unquotedsource.$TourNum"
        !           345:             );
        !           346:     $TourId=CreateTour($dbh,$value,$TournamentId,$TourNum,
        !           347:            \%TourDefaults);
        !           348:     %QuestionDefaults=%QuestionGlobalDefaults;
        !           349:     $QuestionId=0;
        !           350:     next; 
        !           351:       }
        !           352:       if ($key =~ /Вопрос/) {
        !           353:     if (!$TourId) {
        !           354:         $qnum = 0;
        !           355:         $TourNum++;
        !           356:         $TourId=CreateTour($dbh,'1',$TournamentId,$TourNum,
        !           357:                \%TourDefaults);
1.44      roma7     358:         %QuestionDefaults=%QuestionGlobalDefaults;
1.45    ! roma7     359:     }
        !           360:     my $query = "INSERT INTO Questions 
        !           361:            (ParentId, Number) 
        !           362:            VALUES ($TourId, $qnum+1)";
        !           363:     $sth = $dbh->prepare($query);
        !           364:     $sth->execute or print $query;;
        !           365:     $QuestionId = $sth->{mysql_insertid};
        !           366:     &UpdateQuestion($dbh, $QuestionId, "Question", $value);
        !           367:     while (my ($key,$value)=each %QuestionDefaults) {
        !           368:         &UpdateQuestion($dbh, $QuestionId, $key, $value);
        !           369:     }   
        !           370:     $qnum++;
        !           371:     $all_qnum++;
        !           372:     next;
        !           373:       }
        !           374: 
        !           375:       if ($key =~ /Ответ/) {
        !           376:     &UpdateQuestion($dbh, $QuestionId, "Answer", $value);
        !           377:     next;
        !           378:       }
        !           379: 
        !           380: 
        !           381:       if ($key =~ /Зач[её]т/) {
        !           382:     &UpdateQuestion($dbh, $QuestionId, "PassCriteria", $value);
        !           383:     next;
        !           384:       }
        !           385: 
        !           386: 
        !           387: 
        !           388:       if ($key =~ /Комментари/) {
        !           389:     &UpdateQuestion($dbh, $QuestionId, "Comments", $value);
        !           390:     next;
        !           391:       }
        !           392: 
        !           393: 
        !           394:       
        !           395:       my @Fields = grep { $key =~ /$_/ } keys %QuestionFields;
        !           396: 
        !           397:       if (scalar @Fields) {
        !           398:     my $word = shift @Fields;
        !           399:     my $field = $QuestionFields{$word};
        !           400:     if ($QuestionId) {
        !           401:         &UpdateQuestion($dbh, $QuestionId, $field, $value);
        !           402:     } elsif ($TourId) {
        !           403:         $QuestionDefaults{$field}=$value;
        !           404:     } else {
        !           405:         $QuestionGlobalDefaults{$field}=$value;
        !           406:     }
        !           407:     next;
        !           408:       }
        !           409: 
        !           410:       @Fields = grep { $key =~ /$_/ } keys %TourFields;
        !           411: 
        !           412:       if (scalar @Fields) {
        !           413:     my $word = shift @Fields;
        !           414:     my $field = $TourFields{$word};
        !           415:     if ($QuestionId) {
        !           416:         print STDERR "ОШИБКА: $key $value недопустимы после",
        !           417:         " начала вопросов\n";
        !           418:     } elsif ($TourId) {
        !           419:         &UpdateTournament($dbh, $TourId, $field, $value);
        !           420:     } else {
        !           421:         &UpdateTournament($dbh, $TournamentId, $field, $value);
        !           422:         $TourDefaults{$field}=$value;
        !           423:     }
        !           424:     next;
        !           425:       }
        !           426: 
        !           427:       
        !           428:       #
        !           429:       # If we are here, something got wrong!
        !           430:       #
        !           431:       print STDERR "\nЯ НЕ ПОНИМАЮ: $key, $value!\n";
        !           432:       
        !           433:   }
        !           434:   $dbh->do("UPDATE Tournaments SET QuestionsNum=$qnum
        !           435:       WHERE Id=$TourId");
        !           436:   $dbh->do("UPDATE Tournaments SET QuestionsNum=$all_qnum
        !           437:       WHERE Id=$TournamentId");
        !           438:   &UpdateParents($dbh, $ParentId, $all_qnum,$UnquotedCreated);    
        !           439:   print STDERR "Всего вопросов: $all_qnum \n";
1.5       boris     440:     }
1.27      roma7     441:     close UNSORTED;
1.34      roma7     442:     unlink $unsortedname unless $isunsorted;
1.5       boris     443:     $dbh->disconnect;
1.1       boris     444: }

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