Return to createindex.pl CVS log

Up to [Local Repository] / db / prgsrc

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

1.1       boris       1: #!/usr/local/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: createindex.pl - a script for creation of index of the database
                      6: 
                      7: =head1 SYNOPSIS
                      8: 
                      9: createindex.pl [B<-h]] | [B<-o> I<output_file>]
                     10: 
                     11: 
                     12: =head1 DESCRIPTION
                     13: 
                     14: This script will dump the current information about tournaments 
                     15: tree to the standard output or I<output_file> in the format
                     16:   ç|I<file> N*tabstops  I<Name>
                     17: 
                     18: where ç is for groups, I<file> is for packages, N is the depth+2, I<Name>
                     19: is the name of the group/tournament
                     20: 
                     21: =head1 BUGS
                     22: 
                     23: The database, user and password are hardcoded. 
                     24: 
                     25: =head1 AUTHOR
                     26: 
                     27: Boris Veytsman
                     28: 
1.2     ! boris      29: =head1 $Id: createindex.pl,v 1.1 2000/10/18 15:46:45 boris Exp boris $
1.1       boris      30: 
                     31: =cut
                     32: 
                     33: 
1.2     ! boris      34:     use DBI;
1.1       boris      35: use strict;
1.2     ! boris      36: use vars qw($opt_o $opt_h);
        !            37: use Getopt::Std;
        !            38: 
        !            39: my $USAGE="Usage: createindex.pl -o output_file\n";
        !            40: 
        !            41: getopts('ho:') or die $USAGE;
        !            42: if($opt_h) 
        !            43: {
        !            44:     print $USAGE;
        !            45:     exit 0;
        !            46: }
        !            47: if($opt_o) 
        !            48: {
        !            49:     open (OUT, ">$opt_o") or die "Cannot open $opt_o";
        !            50:     select OUT;
        !            51: }
        !            52: 
        !            53: my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") 
        !            54:     or die "Cannot connect!";
        !            55: 
        !            56: PrintAll($dbh,0,0);
        !            57: 
        !            58: $dbh->disconnect;
        !            59: exit 0;
        !            60: 
        !            61: sub PrintAll {
        !            62:     my ($dbh, $Id, $depth) = @_;
        !            63:     my (%Tournament) = &GetTournament($dbh, $Id);
        !            64:     my (@Tours) = &GetTours($dbh, $Id);
        !            65:     if ($Id) {
        !            66:        if ($Tournament{'Type'} eq 'ç') {
        !            67:            for (my $i=0; $i<$depth; $i++) {
        !            68:                print "\t";
        !            69:            }
        !            70:            print $Tournament{'Title'}, "\n";
        !            71:            for (my $i = 0; $i < scalar @Tours; $i++) {
        !            72:                PrintAll($dbh, $Tours[$i],$depth+1);
        !            73:            } 
        !            74:        } else {
        !            75:            print $Tournament{'FileName'};
        !            76:            my $length = 12 -length($Tournament{'FileName'});
        !            77:            for (my $i=0; $i<$length; $i++) {
        !            78:                print " ";
        !            79:            }
        !            80:            for (my $i=1; $i<$depth; $i++) {
        !            81:                print "\t";
        !            82:            }
        !            83:            print $Tournament{'Title'}, "\n";
        !            84:        }
        !            85:     } else {
        !            86:        for (my $i = 0; $i < scalar @Tours; $i++) {
        !            87:            PrintAll($dbh, $Tours[$i],$depth+1);
        !            88:        }
        !            89: } 
        !            90:        
        !            91: }
        !            92: 
        !            93: 
        !            94: 
        !            95: sub GetTournament {
        !            96:        my ($dbh, $Id) = @_;
        !            97:        my (%Tournament, $field, @arr);
        !            98: 
        !            99:        return %Tournament if ($Id == 0);
        !           100: 
        !           101:        my ($sth) = $dbh->prepare("SELECT * FROM Tournaments WHERE Id=$Id");
        !           102:        $sth->execute;
        !           103: 
        !           104:        @arr = $sth->fetchrow;
        !           105:        my($i, $name) = 0;
        !           106:        foreach $name (@{$sth->{NAME}}) {
        !           107:                $Tournament{$name} = $arr[$i++];
        !           108:        }
        !           109: 
        !           110:        return %Tournament;
        !           111: }
        !           112: 
        !           113: sub GetTours {
        !           114:        my ($dbh, $ParentId) = @_;
        !           115:        my (@arr, @Tours);
        !           116: 
        !           117:        my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
        !           118:                WHERE ParentId=$ParentId ORDER BY Id");
        !           119: 
        !           120:        $sth->execute;
        !           121: 
        !           122:        while (@arr = $sth->fetchrow) {
        !           123:                push @Tours, $arr[0];
        !           124:        }
        !           125: 
        !           126:        return @Tours;
        !           127: }
1.1       boris     128: