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

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.4     ! boris      42: =head1 $Id: updateindex.pl,v 1.3 2000/10/19 01:06:18 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");
        !           149:     }  
        !           150:     return $Id;
1.1       boris     151: }

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