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

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: 
                      9: updateind.pl [B<-i> I<indexfile>]
                     10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
                     14: Upadets metainformation in the B<chgk> databse. Uses file
                     15:     L<./index> unless [B<-i>] option is used
                     16: 
                     17: An example of the index file follows:
                     18: 
1.3       boris      19:                 Авторские вопросы
                     20:                         Виктор Байрак
                     21:  bayrak.txt                    Вопросы В.Байрака
                     22:                         Борис Бурда
                     23:  burda.txt                     Вопросы Бориса Бурды
                     24:  burda1.txt                    Тренировки Бориса Бурды 1
                     25:  burda10.txt                   Тренировки Бориса Бурды 10
                     26:  burda11.txt                   Тренировки Бориса Бурды 11
                     27:  burda12.txt                   Тренировки Бориса Бурды 12
                     28: 
1.1       boris      29: 
                     30: =head1 BUGS
                     31: 
                     32: The database, user and password are hardcoded. 
                     33: 
                     34: =head1 SEE ALSO
                     35: 
                     36: createindex.pl(1)
                     37: 
                     38: =head1 AUTHOR
                     39: 
                     40: Boris Veytsman
                     41: 
1.5     ! boris      42: =head1 $Id: updateindex.pl,v 1.4 2000/10/19 01:56:44 boris Exp boris $
1.1       boris      43: 
                     44: =cut
                     45: 
                     46:     use strict;
1.2       boris      47: use vars qw($opt_i $opt_h);
1.1       boris      48: 
                     49: use Getopt::Std;
                     50: use DBI;
                     51: 
                     52: MAIN: 
                     53: {
1.2       boris      54:     my $USAGE="Usage: updateindex.pl -i indexfile\n";
1.3       boris      55:     getopts('hi:') or die $USAGE;
1.2       boris      56:     if ($opt_h) {
                     57:        print $USAGE;
                     58:        exit 0;
                     59:     }
                     60:     my($source) = $opt_i || 'index';
                     61:     my($depth, @depthId);
                     62:     my $filename;
                     63:     my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") 
                     64:        or die "Can't connect to DB chgk\n";
                     65: 
                     66:     open INFD, $source or die "Can't open input file: $!\n";
                     67:     while (<INFD>) {
                     68:        chomp;
                     69:        s/
//;
                     70:        next if (/^\s*$/);
1.3       boris      71:        if (s/^(\S+) *//) { # File found
1.2       boris      72:            $filename = $1;
                     73:            $depth = -1;
                     74:        } else {  # Group found
1.3       boris      75:            $filename = '';
1.2       boris      76:            $depth = -2;
                     77:        }
                     78:        s/^(\t*)//;
                     79:        $depth += length($1);
                     80:        if ($depth < 0) {
                     81:            die "Wrong line $_\n";
1.1       boris      82:        }
1.2       boris      83:        s/^\s*//;
                     84:        s/\s$//;
1.4       boris      85:        my $title = $_;
1.2       boris      86:        my $ParentId = ($depth) ? $depthId[$depth - 1] : 0;
1.4       boris      87:        my $Id = CheckId($dbh,$title,$ParentId,$filename);
                     88:        if (!$Id  || $filename) {
                     89:            next;
1.2       boris      90:        }
1.4       boris      91:        $depthId[$depth] = $Id;
1.2       boris      92: 
                     93:     }
                     94:     $dbh->disconnect;
1.4       boris      95: }
                     96: 
                     97: 
                     98: sub CheckId {
                     99:     my ($dbh,$title,$ParentId,$filename) = @_;
                    100:     my $type;
                    101:     my $key;
                    102:     my $value;
                    103:     my $Id = 0;
                    104:     if ($filename) {
                    105:        $type=$dbh->quote('Ч');
                    106:        $key = "FileName";
                    107:        $value = $dbh->quote($filename);
                    108:     } else {
                    109:        $type=$dbh->quote('Г');
                    110:        $key = "Title";
                    111:        $value = $dbh->quote($title);
                    112:     }
                    113:     $title=$dbh->quote($title);    
                    114:     my $sth = $dbh->prepare("SELECT Id FROM Tournaments 
                    115:                              WHERE $key=$value");
                    116:     $sth->execute or die $dbh->errstr;
                    117:     my @arr = $sth->fetchrow;
                    118:     if (scalar @arr) {
                    119:        print "$value is already in the DB!\n";
                    120:        print "Заменить новым значением? [y/N]\n";
                    121:        my $answer = <STDIN>;
                    122:        if ($answer !~ /^[yY]/) {
                    123:            return 0;
                    124:        } else {
                    125:            $Id = $arr[0];
                    126:        } 
                    127:     }
                    128:     if ($Id) {
                    129:        $sth = $dbh->prepare("UPDATE Tournaments
                    130:                              SET Title=$title, ParentId=$ParentId, 
                    131:                              Type=$type
                    132:                              WHERE Id=$Id");
                    133: 
                    134:     } else {
                    135:        $sth = $dbh->prepare("INSERT INTO Tournaments
                    136:                              (Title, ParentId, Type) 
                    137:                              VALUES
                    138:                              ($title, $ParentId,$type)");
                    139:     }
                    140:     $sth->execute or die $dbh->errstr;
                    141:     if (!$Id) {
                    142:        $Id = $sth->{'mysql_insertid'};
                    143:     }
                    144:     if ($filename) {
                    145:        $filename=$dbh->quote($filename);
                    146:        $sth = $dbh->prepare("UPDATE Tournaments
                    147:                              SET FileName=$filename
                    148:                              WHERE Id=$Id");
1.5     ! boris     149:        $sth->execute or die $dbh->errstr;
1.4       boris     150:     }  
                    151:     return $Id;
1.1       boris     152: }

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