Annotation of db/prgsrc/updateindex.pl, revision 1.12

1.1       boris       1: #!/usr/local/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: updateindex.pl - a script for creation of new database. 
                      6: 
                      7: =head1 SYNOPSIS
                      8: 
1.7       boris       9: updateind.pl [B<-i> I<indexfile>] [B<-y>|B<-n>] [B<-r>]
1.1       boris      10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
1.6       boris      14: Upadets metainformation in the B<chgk> databse. 
1.1       boris      15: 
                     16: An example of the index file follows:
                     17: 
1.3       boris      18:                 Авторские вопросы
                     19:                         Виктор Байрак
                     20:  bayrak.txt                    Вопросы В.Байрака
                     21:                         Борис Бурда
                     22:  burda.txt                     Вопросы Бориса Бурды
                     23:  burda1.txt                    Тренировки Бориса Бурды 1
                     24:  burda10.txt                   Тренировки Бориса Бурды 10
                     25:  burda11.txt                   Тренировки Бориса Бурды 11
                     26:  burda12.txt                   Тренировки Бориса Бурды 12
                     27: 
1.1       boris      28: 
1.6       boris      29: =head1 OPTIONS
                     30: 
                     31: =over 4
                     32: 
                     33: =item B<-i> I<indexfile>
                     34: 
                     35: The index file to read (Standard input by default)
                     36: 
                     37: =item B<-y>
                     38: 
                     39: Answer 'yes' to all questions
                     40: 
                     41: =item B<-n>
                     42: 
                     43: Answer 'no' to all questions
                     44: 
1.7       boris      45: =item B<-r>
                     46: 
                     47: Remove all entries with zero QuestionNum
                     48: 
1.1       boris      49: =head1 BUGS
                     50: 
                     51: The database, user and password are hardcoded. 
                     52: 
                     53: =head1 SEE ALSO
                     54: 
                     55: createindex.pl(1)
                     56: 
                     57: =head1 AUTHOR
                     58: 
                     59: Boris Veytsman
                     60: 
1.12    ! roma7      61: =head1 $Id: updateindex.pl,v 1.11 2006/09/25 00:09:43 roma7 Exp $
1.1       boris      62: 
                     63: =cut
                     64: 
                     65:     use strict;
1.7       boris      66: use vars qw($opt_i $opt_h $opt_y $opt_n $opt_r);
1.1       boris      67: 
                     68: use Getopt::Std;
                     69: use DBI;
                     70: 
                     71: MAIN: 
                     72: {
1.7       boris      73:     my $USAGE="Usage: updateindex.pl [-i indexfile] [-y|-n][-r]\n";
                     74:     my $REMOVE=0;
                     75:     getopts('hi:ynr') or die $USAGE;
1.2       boris      76:     if ($opt_h) {
                     77:        print $USAGE;
                     78:        exit 0;
                     79:     }
1.6       boris      80:     my $decision='askuser';
                     81:     if ($opt_y) {
                     82:        $decision = 'yes';
                     83:     } 
                     84:     if ($opt_n ) {
                     85:        $decision = 'no';
                     86:     }
1.7       boris      87:     if ($opt_r) {
                     88:        $REMOVE=1;
                     89:     }
1.6       boris      90:     my($source) = $opt_i;
1.9       roma7      91:     my $champ;
1.2       boris      92:     my($depth, @depthId);
                     93:     my $filename;
                     94:     my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") 
                     95:        or die "Can't connect to DB chgk\n";
1.11      roma7      96: if ($dbh->get_info( 18 )=~/^(5|(4.1))/)  {$dbh->do("SET NAMES 'koi8r'");}
1.6       boris      97:     if ($source) {
                     98:        open INFO, $source or die "Can't open input file: $!\n";
                     99:     } else {
                    100:        *INFO=*STDIN;
                    101:     }
1.8       roma7     102: 
1.6       boris     103:     while (<INFO>) {
1.2       boris     104:        chomp;
                    105:        s/
//;
                    106:        next if (/^\s*$/);
1.9       roma7     107:        if (s/^(\S+\.txt) *//) { # File found
1.2       boris     108:            $filename = $1;
                    109:            $depth = -1;
1.9       roma7     110:            $champ=1;
1.2       boris     111:        } else {  # Group found
1.9       roma7     112:            if (s/^(\S+)//)
                    113:                { $filename = $1;}      
                    114:            else 
                    115:                {$filename = ''}
1.2       boris     116:            $depth = -2;
1.9       roma7     117:            $champ=0;
1.2       boris     118:        }
                    119:        s/^(\t*)//;
                    120:        $depth += length($1);
                    121:        if ($depth < 0) {
                    122:            die "Wrong line $_\n";
1.1       boris     123:        }
1.2       boris     124:        s/^\s*//;
                    125:        s/\s$//;
1.4       boris     126:        my $title = $_;
1.2       boris     127:        my $ParentId = ($depth) ? $depthId[$depth - 1] : 0;
1.6       boris     128:        my $Id = CheckId($dbh,$title,$ParentId,$decision,$filename);
1.9       roma7     129:        if (!$Id  || $champ) {
1.4       boris     130:            next;
1.2       boris     131:        }
1.4       boris     132:        $depthId[$depth] = $Id;
1.2       boris     133: 
                    134:     }
1.6       boris     135:     print STDERR "Всего вопросов: ",
                    136:     UpdateGroup($dbh,0),"\n";
1.7       boris     137:     if ($REMOVE) {
                    138:        print STDERR "Removing empty tours.";
                    139:        $dbh->do("DELETE FROM Tournaments WHERE QuestionsNum=0");
                    140:     }
1.8       roma7     141:     $dbh->do("INSERT INTO Tournaments
1.12    ! roma7     142:                              (Id, Title, ParentId, Type,CreatedAt) 
1.8       roma7     143:                              VALUES
1.12    ! roma7     144:                              (9999, 'Несортированные турниры', 0,'Г',NOW())");
1.8       roma7     145: 
1.2       boris     146:     $dbh->disconnect;
1.4       boris     147: }
                    148: 
                    149: 
                    150: sub CheckId {
1.6       boris     151:     my ($dbh,$title,$ParentId,$answer,$filename) = @_;
1.4       boris     152:     my $type;
                    153:     my $key;
                    154:     my $value;
1.9       roma7     155:     my $Id = 0;        
                    156:     if ($filename && $filename=~/\.txt/) {
1.4       boris     157:        $type=$dbh->quote('Ч');
1.9       roma7     158:     }  else {$type=$dbh->quote('Г');}
                    159:     if ($filename)
                    160:     {
                    161:        $key = "FileName";
                    162:        $value = $dbh->quote($filename);
1.4       boris     163:     } else {
1.9       roma7     164:        $key = "Title";
                    165:        $value = $dbh->quote($title);
1.4       boris     166:     }
1.9       roma7     167: 
1.4       boris     168:     $title=$dbh->quote($title);    
                    169:     my $sth = $dbh->prepare("SELECT Id FROM Tournaments 
                    170:                              WHERE $key=$value");
                    171:     $sth->execute or die $dbh->errstr;
                    172:     my @arr = $sth->fetchrow;
                    173:     if (scalar @arr) {
1.6       boris     174:        if ($answer eq 'askuser') {
                    175:            print "$value is already in the DB!\n";
                    176:            print "Заменить новым значением? [y/N]\n";
                    177:            $answer = <STDIN>;
                    178:        }
1.4       boris     179:        if ($answer !~ /^[yY]/) {
1.6       boris     180:            print STDERR  "Не заменяем $value\n";
1.4       boris     181:            return 0;
                    182:        } else {
1.6       boris     183:            print STDERR  "Заменяем $value\n";
1.4       boris     184:            $Id = $arr[0];
                    185:        } 
                    186:     }
                    187:     if ($Id) {
                    188:        $sth = $dbh->prepare("UPDATE Tournaments
                    189:                              SET Title=$title, ParentId=$ParentId, 
                    190:                              Type=$type
                    191:                              WHERE Id=$Id");
                    192: 
                    193:     } else {
                    194:        $sth = $dbh->prepare("INSERT INTO Tournaments
1.12    ! roma7     195:                              (Title, ParentId, Type,CreatedAt) 
1.4       boris     196:                              VALUES
1.12    ! roma7     197:                              ($title, $ParentId,$type,NOW())");
1.4       boris     198:     }
                    199:     $sth->execute or die $dbh->errstr;
                    200:     if (!$Id) {
                    201:        $Id = $sth->{'mysql_insertid'};
                    202:     }
                    203:     if ($filename) {
                    204:        $filename=$dbh->quote($filename);
                    205:        $sth = $dbh->prepare("UPDATE Tournaments
                    206:                              SET FileName=$filename
                    207:                              WHERE Id=$Id");
1.5       boris     208:        $sth->execute or die $dbh->errstr;
1.4       boris     209:     }  
                    210:     return $Id;
1.1       boris     211: }
1.6       boris     212: 
                    213: sub UpdateGroup {
                    214:     my ($dbh,$Id) = @_;
                    215:     my $sth = $dbh->prepare("SELECT COUNT(*) FROM Questions
                    216:                             WHERE ParentId=$Id");
                    217:     $sth->execute;
                    218:     my @arr=$sth->fetchrow;
                    219:     my $result=$arr[0];
                    220:     my @Tours = GetTours($dbh,$Id);
                    221:     foreach my $TourId (@Tours) {
                    222:        $result += UpdateGroup($dbh,$TourId);
                    223:     }
                    224:     $sth=$dbh->prepare("UPDATE Tournaments SET
                    225:                    QuestionsNum=$result 
                    226:                    WHERE Id=$Id");
                    227:     $sth->execute;
                    228:     return $result;
                    229: }
                    230: 
                    231: sub GetTours {
                    232:        my ($dbh, $ParentId) = @_;
                    233:        my (@arr, @Tours);
                    234: 
                    235:        my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
                    236:                WHERE ParentId=$ParentId ORDER BY Id");
                    237: 
                    238:        $sth->execute;
                    239: 
                    240:        while (@arr = $sth->fetchrow) {
                    241:                push @Tours, $arr[0];
                    242:        }
                    243: 
                    244:        return @Tours;
                    245: }
                    246: 

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