Perl as a team management tool for coaching

I wouldn't expect to see this highly adopted outside of Silicon Valley, but I used Perl this weekend to help me document new rosters for the Fall season. The background is that we have new team formation guidelines and decided to do things by hand. I.e., flip papers over to do random sort by school. I took the lists of teams home and decided to enter them in files. I chose to use file names of u<age><sex>[-<coach>].txt. I also added the player names as I would say them in English, i.e., first and then last name. I noticed that some of the last names had spaces.

I had been reading the sed & awk book from O'Reilly, so my first task (I didn't realize I wanted to do web pages) was to sort the teams by last name and output them as last, then first name.

I tried:

cat $1 | sed "s/\\(.\*\\) \\(.\*\\)/\\2, \\1/" | sort > sort/$1

There is a problem:

[usc@adept girls]$ more u8g-vanhalen.txt
Alley Angle
Big Bang
Kandy Kanaviral
Tailor Raider
Monster Skye
Haley Van Halen
[usc@adept girls]$ cat u8g-vanhalen.txt  | sed "s/\\(.\*\\) \\(.\*\\)/\\2, \\1/" | sort
Angle, Alley
Bang, Big
Halen, Haley Van
Kanaviral, Kandy
Raider, Tailor
Skye, Monster

We want Van Halen and not Haley Van. Also, I put an '\*' at the end of some lines to signal a problem. The easiest regular expression I found was to state I did not want a space in the first name:

[usc@adept girls]$ cat u8g-vanhalen.txt  | sed "s/\\([\^ ]\*\\) \\(.\*\\)/\\2, \\1/" | sort
Angle, Alley
Bang, Big
Kanaviral, Kandy
Raider, Tailor
Skye, Monster
Van Halen, Haley

Okay, I went to sleep since I could print out the rosters in a nice format. When I woke up, I decided I wanted the rosters to be online and I wanted to link in any problems. E.g., Alley might not have turned in her birth certificate. I didn't want to spend too much time with sed or awk, so I went back to Perl. I understand the allure of commercial software for doing leagues, I'm just glad I know how to do data structures. :)

I'm not going to go over much of the details. I sat there and tweaked the script as I wrote it. The hardest part was remembering how to get an array of structures built and dereferenced. And sorting on age group and then name (for the team page) was frustrating.

No, the thing that really bugs me is how do I get this source code into this blog? I have plenty of metacharacters which might get mangled.

[usc@adept teams]$ cat report.pl | sed "s/</\\&lt;/g ; s/>/\\&gt;/g" 

Sweet! I couldn't enter my example as it got mangled!. I had to work to figure out how to get the '&' in there!

I then tested this in a new entry window and made sure it worked.

In the code, you can see where I finally started remembering some of the Perl I had forgotten (or finally made sense of some old scripts I had). I did more pattern matching than I normally do.

The other thing which confused me was the statement:

my($first, $last) = $t =~ /$nameRegEx/;

I kept on thinking it would mangle the contents of $t, but I was getting the precendence wrong. This reads as make a copy of the value of $t, apply the pattern match against that copy, and return the results into $first and $last. It may not be described that way in any of the literature, but it is a way to think of it.

Anyway, here is the script, which is totally useless to anyone other than myself. Except if you want to scavange concepts from it.

#!/usr/bin/perl

#
# Use:
#
# [usc@adept girls]$ ls -1 \*.txt | ../report.pl
#

$, = ' ';        # set output field separator
$\\ = "\\n";       # set output record separator
$| = 1;

# Process the files.

my($nameRegEx) = "([\^ ]\*) (.\*)";

#
# Get the list of coaches
#
# File format is first and then last name.
#
open(FP, "<../coaches.txt") || die "Could not read coaches: $!";
while (<FP>) {
        chomp();

        my($first, $last) = /$nameRegEx/;
        my($id) = join("", split(/ /, $last));
        $id =~ tr/A-Z/a-z/;

        $coaches{$id} = "$first $last";

#       print "$last, $first - $id";
}
close(FP);

my(@arProblems);

#
# Get the list of problems
#
# Fields are ':' separated.
#
open(FP, "<../problems.txt") || die "Could not read problems: $!";

while (<FP>) {
        chomp();

        my($name, $age, $reason) = split(/:/);

        my($first, $last) = $name =~ /$nameRegEx/;

        if ($reason =~ /BC/) {
                $reason = "Needs copy of birth certificate";
        } elsif ($reason =~ /PU/) {
                $reason = "Needs to fill out Play Up Form";
        }

        my(%curr) = ('first' => $first,
                        'last' => $last,
                        'age' => $age,
                        'reason' => $reason);

        push(@arProblems, \\%curr);
}
close(FP);

#my(@ar) = @arProblems;
#for ($j = 0; $j < @ar; $j++) {
#       print join(" ", $ar[$j]{first}, $ar[$j]{last}, $ar[$j]{age}, $ar[$j]{reason});
#}

open(TEAMLIST, ">html/index.html") || die "Could not write html/$base.html: $!";

print TEAMLIST << "EndOfTeamHeader";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title>USC Fall 2006 Teams</title>
</head>
<body>
<h1>Teams</h1>

<ol>
EndOfTeamHeader

#foreach $key (sort(keys(%coaches))) {
#       print $coaches{$key} . " $key";
#}

my(@arTeams);

while (<>) {
        chomp();

        my($file) = $_;
        my($base) = /(.\*)\\.txt/;
        my($i, $key, $coachDisplay, $age);

        my(%players);

        open(FP, ">html/$base.html") || die "Could not write html/$base.html: $!";
        open(TEAM, "<$file") || die "Could not read $file: $!";

        print FP << "EndOfHeader";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title> Team $base</title>
</head>
<body>


EndOfHeader

        my (%curr) = ('file' => $base,
                        'count' => 0,
                        'gender' => "",
                        'age' => 0,
                        'display' => "",
                        'first' => "",
                        'last' => "",
                        'error' => 0,
                        'errorStr' => "");

        if (/-/) {
                my($coachKey);

                ($age, $coachKey) = /(.\*)-(.\*)\\.txt/;

                $age =~ tr/a-z/A-Z/;

                if ($coaches{$coachKey}) {
                        my($t) = $coaches{$coachKey};

                        my($first, $last) = $t =~ /$nameRegEx/;

                        $curr{first} = $first;
                        $curr{last} = $last;

                        print "$file - the coach is $first $last ";
                        print FP "<h1>$age - $coaches{$coachKey}</h1>";
                        $curr{display} = $coaches{$coachKey};
                        if (!($first cmp "The")) {
                                $curr{error} = 1;
                                $curr{errorStr} = "Need first name!";
                        }
                } else {
                        print "$file - has no matching coach for $coachKey";
                        print FP "<h1>$age - $coachKey <font color=\\"red\\">No matching Coach entry!</font></h1>";
                        $curr{display} = $coachKey;
                        $curr{error} = 1;
                        $curr{errorStr} = "No matching Coach entry!";
                }
        } else {
                $age = $base;
                $age =~ tr/a-z/A-Z/;

                print "$file - has no coach!";
                print FP "<h1>$age - <font color=\\"red\\">Coach to be assigned</font></h1>";
                $curr{display} = $age;
                $curr{error} = 1;
                $curr{errorStr} = "Coach to be assigned!";
        }

        my($ageGroup, $gender) = $age =~ /U(\\d\*)(.\*)/;

        $curr{age} = $ageGroup;
        $curr{gender} = $gender;

        print FP "\\n\\n";

        while (<TEAM>) {
                chomp();

                $key = $_;
                $key =~ s/([\^ ]\*) (.\*)/\\2, \\1/g;

#               print "Adding $key";
                $players{$key} = $_;
        }

        $i = 0;
        print FP "<ol>";
        foreach $key (sort(keys(%players))) {
                my($first, $last) = $players{$key} =~ /$nameRegEx/;

                my($problemStr) = "";

                #
                # Search for a problem
                #
                for ($j = 0; $j < @arProblems; $j++) {
                        if (($first eq $arProblems[$j]{first})
                                        && ($last eq $arProblems[$j]{last})) {
                                $problemStr = " <font color=\\"red\\">" . $arProblems[$j]{reason} . "</font>";
                                print "XXX $first $last $problemStr";
                        } else {
#                               print "YYY $first $last no match on " . join(" ",
#                                               $arProblems[$j]{first}, $arProblems[$j]{last},
#                                               $arProblems[$j]{age}, $arProblems[$j]{reason});
                        }
                }

                if ($key =~ /\\\*/) {
                        print FP "<li>$key $problemStr <font color=\\"red\\">Not yet added to team, reserving spot.</font></li>";
                } else {
                        print FP "<li>$key $problemStr </li>";
                }
                $i++;
        }
        print FP "</ol>";

        print FP << "EndOfFooter";


</body>
</html>
EndOfFooter

        close(TEAM);
        close(FP);

        $curr{count} = $i;
        push(@arTeams , \\%curr);

        undef(%players);
}

#sub sortByAgeThenLast {
#       if ($$b{age} < $$a{age}) {
#               -1;
#       } elsif ($$b{age} > $$a{age}) {
#               +1
#       } else {
#               $$a{last} cmp $$b{last};
#       }
#}

sub sortByAgeThenLast {
#       print $$a{age} . " vs " . $$b{age} . " and (" . $$a{last} . " vs " . $$b{last} . ")";
        if ($$b{age} < $$a{age}) {
                +1;
        } elsif ($$b{age} > $$a{age}) {
                -1;
        } else {
                $$a{last} cmp $$b{last};
        }
}

my(@ar) = sort(sortByAgeThenLast @arTeams);

for ($i = 0; $i < @ar; $i++) {
        if ($ar[$i]{error}) {
                print TEAMLIST "<li><a href=\\"" . $ar[$i]{file} . ".html\\"> U"
                        . $ar[$i]{age} . $ar[$i]{gender} . " - " . $ar[$i]{display}
                        . "</a>  Players: " . $ar[$i]{count} . " - <font color=\\"red\\">"
                        . $ar[$i]{errorStr} . "</font></li>";
        } else {
                print TEAMLIST "<li><a href=\\"" . $ar[$i]{file} . ".html\\"> U"
                        . $ar[$i]{age} . $ar[$i]{gender} . " - " . $ar[$i]{display}
                        . "</a>  Players: " . $ar[$i]{count} . "</li>";
        }
}

        print FP << "EndOfTeamFooter";
</ol>


</body>
</html>
EndOfTeamFooter

close(TEAMLIST);

exit(0);
        print join(" ", $ar[$i]{file},
                        $ar[$i]{count},
                        $ar[$i]{age},
                        $ar[$i]{display},
                        $ar[$i]{first},
                        $ar[$i]{last},
                        $ar[$i]{error},
                        $ar[$i]{errorStr});


Technorati Tags:
Orginally posted on Kool Aid Served Daily
Copyright (C) 2006, Kool Aid Served Daily
Comments:

Post a Comment:
  • HTML Syntax: NOT allowed
About

tdh

Search

Archives
« April 2014
SunMonTueWedThuFriSat
  
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
   
       
Today