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

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

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