Return to validate.pl CVS log

Up to [Local Repository] / db / prgsrc

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

1.1       boris       1: #!/usr/local/bin/perl 
                      2: 
                      3: =head1 NAME
                      4: 
1.2     ! boris       5: validate.pl - a script to validate files for db
1.1       boris       6: 
                      7: =head1 SYNOPSIS
                      8: 
1.2     ! boris       9: validate.pl  I<file1> I<file2>....
1.1       boris      10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
1.2     ! boris      14: Validates files
1.1       boris      15: 
                     16: =head1 OPTIONS
                     17: 
                     18: =item B<-i> 
                     19: 
                     20: =head1 AUTHOR
                     21: 
1.2     ! boris      22: Boris Veytsman, based on a script by Dmitry Rubinstein
1.1       boris      23: 
1.2     ! boris      24: =head1 $Id: validate.pl,v 1.1 2005/03/07 02:37:51 boris Exp $
1.1       boris      25: 
                     26: =cut
                     27: 
                     28: 
                     29: my (%RevMonths) = 
                     30:     ('Jan', '1', 'Feb', '2', 'Mar', '3', 'Apr', '4', 'May', '5', 'Jun', '6',
                     31:      'Jul', '7', 'Aug', '8', 'Sep', '9', 'Oct', '10', 'Nov', '11',
                     32:      'Dec', '12', 
                     33:      'JAN', '1', 'FEB', '2', 'MAR', '3', 'APR', '4', 'MAY', '5', 'JUN', '6',
                     34:      'JUL', '7', 'AUG', '8', 'SEP', '9', 'OCT', '10', 'NOV', '11',
                     35:      'DEC', '12', 
                     36:      'Янв', '1', 'Фев', '2', 'Мар', '3', 'Апр', '4', 'Май', '5',
                     37:      'Июн', '6', 'Июл', '7', 'Авг', '8', 'Сен', '9', 
                     38:      'Окт', '10', 'Ноя', '11', 'Дек', '12');
                     39: my ($sth);
                     40: 
                     41: 
                     42: 
                     43: 
                     44: 
                     45: use strict;
                     46: 
                     47: 
                     48: sub getField {
1.2     ! boris      49:     my($desc) = @_;
1.1       boris      50:     my($key);
                     51:     my($value) = ('');
                     52:     while (<$desc>) {
                     53:        s/[
]//g;
                     54:        if ($key && /^\s*$/) {
                     55:            chomp $value;
                     56:             $value =~ s/\s+$//;
                     57:            chomp $key;
                     58:            if ($key eq 'Дата') {
                     59:                $value =~ s/^(.*)-(.*)-(.*)$/$3-$2-$1/;
                     60:                my($month) = $RevMonths{$2} || '01';
                     61:                $value =~ s/-(.*)-/-$month-/;
                     62:                $value =~ s/-00*$/-01/;
                     63:            }
                     64:            if ($key eq 'Автор') {$value=~s/\.$//;}
                     65:            return ($key, $value);
                     66:        }
                     67:        next if (/^\s*$/);
                     68:        
                     69:        if (!$key && /^(.*?)[:\.]\s*(.*)$/s) {
                     70:            $key = $1;
                     71:            $value=$2;
                     72:            next;
                     73:        }
                     74:        if ($key) {
                     75:            $value .= $_;
                     76:            next;
                     77:        }
                     78:     }
                     79:     if ($key && $value) {
                     80:         $value=~s/\s+$//;
                     81:        return ($key, $value);
                     82:     }
                     83:     return (0, 0);
                     84: }
                     85: 
                     86:                
                     87: 
                     88: MAIN: 
                     89: {
                     90:     my($key, $value, $addition);
                     91:     #
                     92:     # Inherited fields for a Tour or Tournament
                     93:     #
                     94:     my %TourFields = ('Копирайт' => 'Copyright',
                     95:                      'Инфо' => 'Info', 'URL' => 'URL',
                     96:                      'Ссылка' => 'URL', 'Редактор' => 'Editors',
                     97:                      'Обработан'=> 'EnteredBy',
                     98:                      'Дата'=>'PlayedAt');
                     99:     #
                    100:     # Inherited fields for a Question
                    101:     #
                    102:     my %QuestionFields = ('Тип'=> 'Type', 'Вид'=> 'Type', 
                    103:                          'Автор' => 'Authors', 'Рейтинг'=>'Rating', 
                    104:                          'Источник' => 'Sources',
                    105:                          'Тема' => 'Topic');
                    106:                          
                    107:                      
                    108:     my($source);
                    109:     
                    110:     my @sources;       
                    111:     while ($source = shift) {
                    112:        push @sources,glob($source);
                    113:     }
                    114:     foreach $source(@sources) {
                    115:        my $TourNum=0;
                    116:        my($PlayedAt) = '';
                    117:        my($QuestionId, $TourId, $TournamentId, $ParentId) = (0, 0, 0, 0);
                    118:        my($tournum, $qnum, $all_qnum) = (0, 0, 0);
                    119:        my (@d) = (localtime((stat($source))[9]))[5,4,3];
                    120:        $d[1]++;
                    121:        $d[1]=sprintf("%02d",$d[1]);
                    122:        $d[2]=sprintf("%02d",$d[2]);
                    123:        $d[0]+=1900;
1.2     ! boris     124:        my $CreatedAt=join('-', @d);
1.1       boris     125: 
                    126:        open INFD, $source 
                    127:            or die "Can't open input file: $!\n";
                    128:        
                    129:        $source =~ s/^.*\/([^\/]*)$/$1/;
                    130:        print STDERR "Файл: $source, дата: $CreatedAt ";
1.2     ! boris     131:        while (($key, $value) = getField(\*INFD)) {
1.1       boris     132:            last if (!$key);
                    133:            
                    134:            if ($key =~ /Мета/) {
                    135:                next;   # This is obsolete
                    136:            }
                    137:            if ($key =~ /Чемпионат/ || $key =~ /Пакет/) {               
                    138:                next;
                    139:            }
                    140:            if ($key =~ /Тур/) {
                    141:                $qnum = 0;
                    142:                $TourNum++;
                    143:                $QuestionId=0;
                    144:                next;   
                    145:            }
                    146:            if ($key =~ /Вопрос/) {
                    147:                $qnum++;
                    148:                $all_qnum++;
                    149:                next;
                    150:            }
                    151: 
                    152:            if ($key =~ /Ответ/) {
                    153:                next;
                    154:            }
                    155: 
                    156: 
                    157:            if ($key =~ /Зач[её]т/) {
                    158:                next;
                    159:            }
                    160: 
                    161: 
                    162: 
                    163:            if ($key =~ /Комментари/) {
                    164:                next;
                    165:            }
                    166: 
                    167: 
                    168:            
                    169:            my @Fields = grep { $key =~ /$_/ } keys %QuestionFields;
                    170: 
                    171:            if (scalar @Fields) {
                    172:                next;
                    173:            }
                    174: 
                    175:            @Fields = grep { $key =~ /$_/ } keys %TourFields;
                    176: 
                    177:            if (scalar @Fields) {
                    178:                next;
                    179:            }
                    180: 
1.2     ! boris     181: 
1.1       boris     182:            
                    183:            #
                    184:            # If we are here, something got wrong!
                    185:            #
                    186:            print STDERR "\nЯ НЕ ПОНИМАЮ: $key, $value!\n";
                    187:            
                    188:        }
                    189:        print STDERR "Всего вопросов: $all_qnum \n";
                    190:     }
                    191: }