Return to createindex.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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.3     ! boris      29: =head1 $Id: createindex.pl,v 1.2 2000/10/18 18:46:30 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 'ç') {
1.3     ! boris      67:            for (my $i=0; $i<=$depth; $i++) {
1.2       boris      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: