http://qs1969.pair.com?node_id=136206
Category: Miscellaneous
Author/Contact Info Joseph F. Ryan, ryan.311@osu.edu
Check my homenode for more contact methods
Description:

Gradebook is a module useful for parsing Gradebook Plus text reports, a program used by many K-12 school districts. Simplely go to Reports->Gradebook of entire Class->(check fancy report, catagory totals, and sum/pct/grade)->Save to disk. The parser can then parse the contents of this file. Use it how you like; I use it so teachers can put their grades online with minimal effort on their part. It is fairly robust (especially considering the extremely unfriendly formating parsing-wise) and has methods to access all data for your convience. Note that parsing this isn't as easy as it looks; when the report gets to more than 80 columns it wraps itself to a new page. You can have up to 90 grades, which can be up to 10 pages in length. To make it even more fun, the pages are just concatrated one after another. Hence the need for a module :) Read the pod for more info. Also, you can find yourself a copy of Gradebook plus at:http://www.svemedia.com/demo.html


Update:A Sample Gradebook dump (as suggested by crazy: (this is the Gradebook supplied in the demo with 2 records added)

Carlmont School Kingsfield's Per 7 Government Gradebook as of Fri Jan 4, 2002 Name 1 2 3 4 5 6 7 Total Pct. -------------------------------------------------------------------- Adams, John 10 10 13 9 76 30 3 151 82.5 Adams, Quincy 10 10 12 9 67 30 3 141 77.0 Cleveland, Grover 10 10 11 10 68 30 3 142 77.6 Coolidge, Cal 10 10 14 10 82 30 3 159 86.9 Eisenhower, Dwight 10 10 15 10 93 30 3 171 93.4 Fillmore, Millard 10 10 16 10 100 30 3 179 97.8 Ford, Jerry 10 10 19 ( ) 93 30 3 165 90.2 Grant, U. S. 10 10 18 10 68 30 3 149 81.4 Harding, Warren 10 10 17 10 73 30 3 153 83.6 Hoover, Herb 10 10 20 10 92 30 3 175 95.6 Jackson, Andy 10 10 20 10 95 30 3 178 97.3 Jefferson, Tommy 10 10 19 10 78 30 3 160 87.4 Kennedy, Jack 10 10 16 10 72 30 3 151 82.5 Lincoln, Abe 10 10 18 10 75 30 3 156 85.2 Madison, Jim 9 10 14 10 80 30 3 156 85.2 McKinley, Bill ( ) 10 12 10 70 30 3 135 73.8 Monroe, John 10 10 16 5 93 30 3 167 91.3 Pierce, Frank 9 10 18 8 83 30 3 161 88.0 Polk, James 9 10 15 9 68 30 3 144 78.7 Roosevelt, Frankie 10 10 19 10 73 30 3 155 84.7 Roosevelt, Teddy 10 10 17 10 72 30 3 152 83.1 Truman, Harry 10 10 17 10 77 30 3 157 85.8 Tyler, John 10 10 10 9 88 30 3 160 90.9 Washington, George ( ) 10 14 10 79 30 3 146 79.8 Wilson, Woody 10 10 17 10 72 30 3 152 83.1 Average : 9 10 16 19 79.5 30 3 155.4 85.7 Possible : 10 10 20 10 100 30 3 183 "( )" Indicates the assignment was not submitted. Key : 1) HW 9-11 5) TEST- Chap 1 2) HW 9-12 6) test 3) QUIZ 7) next 4) HW 9-14 Carlmont School Kingsfield's Per 7 Government Gradebook as of Fri Jan 4, 2002 Name Grade Cat 1 Cat 2 Cat 3 ------------------------------------------------------------------ Adams, John B 81.5 96.7 69.6 Adams, Quincy C 74.6 96.7 65.2 Cleveland, Grover C 75.4 100.0 60.9 Coolidge, Cal B 86.2 100.0 73.9 Eisenhower, Dwight A 94.6 100.0 78.3 Fillmore, Millard A 100.0 100.0 82.6 Ford, Jerry A 94.6 66.7 95.7 Grant, U. S. B 75.4 100.0 91.3 Harding, Warren B 79.2 100.0 87.0 Hoover, Herb A 93.8 100.0 100.0 Jackson, Andy A 96.2 100.0 100.0 Jefferson, Tommy B 83.1 100.0 95.7 Kennedy, Jack B 78.5 100.0 82.6 Lincoln, Abe B 80.8 100.0 91.3 Madison, Jim B 84.6 96.7 73.9 McKinley, Bill C 76.9 66.7 65.2 Monroe, John A 94.6 83.3 82.6 Pierce, Frank B 86.9 90.0 91.3 Polk, James C 75.4 93.3 78.3 Roosevelt, Frankie B 79.2 100.0 95.7 Roosevelt, Teddy B 78.5 100.0 87.0 Truman, Harry B 82.3 100.0 87.0 Tyler, John A 90.8 90.0 100.0 Washington, George C 83.8 66.7 73.9 Wilson, Woody B 78.5 100.0 87.0 Average : 84.2 93.9 83.8 Possible : 60 20 20 "( )" Indicates the assignment was not submitted. Category Key : 1) TEST 2) HW 3) OTHER
package Gradebook;
use strict;
use warnings;

sub new
{
    my $proto = shift;

    my $self      = {};
    my $class     = ref($proto) || $proto;
    $self->{index} = 0;

    bless ($self, $class);
}

sub parse
{
    my ($self, $dump) = @_;
    chomp $dump;
    $dump = reverse $dump;
    chomp $dump;
    $dump = reverse $dump;
    my @dump = split (/\n/, $dump);

# determine the amount of sections in the script.  In a 1 pager, it wi
+ll be 3, 2 pages will be 5, 3 will be 7...
    my @sections;
    my $q=0;
    foreach my $line (@dump)
    {
        if ($line =~ /^\-+/i)
    {
        $q++;
        next;
    }
        $sections[$q] .= $line."\n";
        $q++ if ($line =~ /^Possible :/i);
    }
    $q = ($q/2);

# get the title
    chomp (@dump);
    my $firstline = 0;

    do { $firstline = shift @dump } while ( $firstline !~ /[a-z]+/ );

    $self->{name} = $firstline."\n".(shift @dump)."\n".(shift @dump);
    shift @dump;

# the length of the longest possible record
    my @fields = split (/\s+/, shift @dump);
    shift @dump;
    my ($length) = $dump[0] =~ /^(.*?\s.*?\s+)[^\s]/;
    $length      = length($length)-3;

# grabs the records out of the sections
    my @names;
    my @student_info;
    for (my $i=1; $i<@sections; $i+=2)
    {
        push @student_info, join("\n",grep{$_}map{
                                          my $l = ($length<length($_))
+?$length:length($_);
                                          push(@names,substr($_,0,$l))
+;
                                          $_=substr($_,$l,length($_)-$
+l)
                                         }
                                      split(/\n/,$sections[$i]));
        delete $sections[$i];
    }

# remove duplicate names
    @names = do{my%h;grep{!$h{$_}++}@names};

# concatrate records spanning multiple pages.
    my @temp_students = @student_info;
    @student_info = ();
    foreach my $temp (@temp_students)
    {
        my @temp = split(/\n/, $temp);
        for (my $i=0; $i<@temp; $i++)
        {
             $student_info[$i] .= $temp[$i];
        }
    }
@student_info = grep{$_}@student_info;
@names = grep{$_}@names;
# reappend name back to record
    for (my $i=0; $i<@names; $i++)
    {
        $student_info[$i] = $names[$i].$student_info[$i];
    }

# remove deleted sections
    @sections = grep{$_}@sections;

# concatrate field headings spanning multiple pages
    for (my $i=1; $i<(@sections-1); $i++)
    {
        my @entry = split (/\n/, $sections[$i]);
        my @temp = (split /\s+/, $entry[$#entry]);
        push (@fields, @temp);
    }
    $q=0;
    for (0..$#fields)
    {
        delete $fields[$_] if (($fields[$_] =~ /name/i) && $q);
        next if !$fields[$_];
        $q++ if ($fields[$_] =~ /name/i);
    }

# remove empty fields and strip illegal characters
    @fields = grep{$_}@fields;

# count number of assignments
    my $noa = -1;
    for (my $i=1; $i < @fields; $i++)
    {   last unless ($fields[$i] =~ /^\d+$/);
        $noa++;
    }

    my $student = {};
    my @order = ();
    my $loc = 0;
    my $empty = 0;

# parse records
    foreach my $dump (@student_info)
    {
        $loc++;
        chomp $dump;
        last if ($dump eq '');
        last if ($dump eq "\n");
        last if ($dump eq "\r");
        last if ($dump eq "\r\n");
        last if ($dump eq "\n\r");
        last if ($dump =~ /average/i);
        last if ($dump =~ /:/);
        my ($name, $rest) = ($dump =~ /(.*?)(\d.*)/) or last;
        my @data = split(/\s+/, $rest);

        my @data1     = split (/\,/, $name);
        my $lastname  = shift @data1;
        my $firstname = shift @data1;
        ($firstname)  = $firstname =~ m/^\s*(.*?)\s*$/;
        ($lastname)   = $lastname  =~ m/^\s*(.*?)\s*$/;

        last if (lc($lastname) !~ /[a-z?]/);

        $name = $firstname."_".$lastname;
        push (@order, $name);

        # assignments

        my %assignments;
        my $data = join ' ', @data;
    $empty++ if ($data =~ s/(\(\s+\))/ () /g);
    $data =~ s/(ex)/0/g;
    @data = split(/\s+/, $data);

        for my $i (0 .. $noa)
        {
            my $entry = shift @data;
            $assignments{$fields[$i+1]} = $entry;
        }

        my $total   = shift @data;
        my $percent = shift @data;
        my $grade   = shift @data;

        my %catagories;
        my $count = 1;
        foreach my $entry (@data)
        {
            $catagories{$count} = $entry;
            $count++;
        }

        my $password = crypt ($lastname, $firstname);
        $password = ( length($password) > 6 ) ? substr($password, 0, 6
+) : $password;
        $password =~ tr/.,!@#$%^&*(){}[]/q/;

        $student->{$name} = {
                             firstname  => $firstname,
                             lastname   => $lastname,
                             password   => $password,
                             grade      => $grade,
                             total      => $total,
                             percent    => $percent,
                             assignment => {%assignments},
                             catagory   => {%catagories},
                            }
    }
    my @info = @student_info[$loc-1 .. $#student_info];

    my @averages = split (/\s+/, shift @info);
        shift @averages;
        shift @averages;
        my %a_averages = ();

        for my $i (0 .. $noa)
        {
            my $average = shift @averages;
            $a_averages{$i+1} = $average;
        }

        my $total_average = shift @averages;
        my $pct_average   = shift @averages;
        my %c_averages = ();

        for my $i (0..@averages)
        {
            $c_averages{$i+1} = $averages[$i];
        }

        my %averages = (
                        assignment => {%a_averages},
                        catagory   => {%c_averages},
                       );

    my @possible = split (/\s+/, shift @info);
        shift @possible;
        shift @possible;
        my %a_possible = ();
        for my $i (0 .. $noa)
        {
            my $possible = shift @possible;
            $a_possible{$i+1} = $possible;
        }

        my $total_possible = shift @possible;
        my %c_possible = ();

        for my $i (0..@possible)
        {
            $c_possible{$i+1} = $possible[$i];
        }

        my %possible = (
                        assignment => {%a_possible},
                        catagory   => {%c_possible},
                       );

     my @detailed;
     foreach my $section (@sections)
     {
         $section  .= $firstline;
         ($section) = $section =~ /^(.*?)\Q$firstline\E/si;
     }

     @info = ();
     foreach my $section (@sections)
     {
         my @entry = split (/\n/, $section);
         push (@info, @entry);
     }

     @info = grep{$_}@info;
     @info = do{my%h;grep{!$h{$_}++}@info};
     @info = grep{$_ !~ /\Q"( )"  Indicates the assignment was not sub
+mitted.\E/i}@info;
     @info = grep{$_ !~ /\Q"ex"   Indicates student exempted from entr
+y.\E/i}@info;


     $noa++;
     my @asses;

     shift @info;
     # shift @info;

     while (my $entry = shift @info)
     {
         chomp $entry;
         last if ($entry eq '');
         last if ($entry eq "\n");
         last if ($entry eq "\r");
         last if ($entry eq "\r\n");
         last if ($entry eq "\n\r");
         last if ($entry =~ /^Category/i);
         $entry =~ s/(\d+\))/  $1/g;
         $entry =~ tr/(/{/;
         $entry =~ s/(?:(\{[^)]*)(?<!\d)(\)*))/$1} /gi;
         $entry =~ s/\s*\}/} /g;
         my @row = grep{$_}
         map{
             tr/\n\r//d;
             s/(.*?)\s*$/$1/;
             tr/ /_/;
             s/_//;
             s/_// if(/^\d+\)_/);
             $_
            }

         split(/\s{2,}/, $entry);
         push (@asses, @row);
     }

     my %a_names;
     foreach my $entry (@asses)
     {
         chomp $entry;
         my @a_names = split(/\)/, $entry);
         $a_names[1] =~ s/[^\w\d]//g;

         $a_names{$a_names[0]} = $a_names[1];
     }

     my @assignment_names = @fields[1 .. $noa];
     foreach my $assignment (@assignment_names)
     {
         $assignment = $a_names{$assignment};
     }

     #shift @info;

     my @catagory_names;
     #my @catagories = split (/\s+/, shift @info);


     #for (my $i=1; $i<@catagories; $i+=2)
     #{
     #    push (@catagory_names, $catagories[$i+1]);
     #}

     $self->{student}        = $student;
     $self->{average}        = {%averages};
     $self->{assignment}     = [@assignment_names];
     $self->{catagory}       = [@catagory_names];
     $self->{order}          = [@order];
     $self->{possible}       = {%possible};
     $self->{class_average}  = $pct_average;
     $self->{total_average}  = $total_average;
     $self->{total_possible} = $total_possible;
}

sub report_name
{
     my $self = shift;
     return (join "\n", map {s/\s{2,}//; $_} split (/\n/, $self->{name
+}));
}

sub list_students
{
    my $self = shift;
    my @return_array;
    foreach my $name (keys(%{$self->{student}}))
    {
        my $lastname  = $self->{student}->{$name}->{lastname};
        my $firstname = $self->{student}->{$name}->{firstname};
        my $password  = $self->{student}->{$name}->{password};
        push (@return_array, {first=>$firstname, last=>$lastname, pw=>
+$password});
    }
    return @return_array;
}

sub next_student
{
    my $self = shift;
    my $returnv =  ${$self->{order}}[$self->{index}];
    $self->{index}++;
    $self->{index} = 0 if ($self->{index} > $#{$self->{order}});
    return $returnv;
}

sub average_percent
{
    my $self = shift;
    return $self->{class_average};
}

sub average_points
{
    my $self = shift;
    return $self->{total_average};
}

sub possible_points
{
    my $self = shift;
    return $self->{total_possible};
}

sub assignment_names
{
    my $self = shift;
    return @{$self->{assignment}}
}

sub assignment_possible
{
    my ($self, $name) = @_;
    my $index = get_index($name, @{$self->{assignment}});
    return $self->{possible}->{assignment}->{$index};
}

sub assignment_scores
{
    my ($self, $name) = @_;
    my @return_array;

    my $index = get_index ($name, @{$self->{assignment}});
    foreach my $student (@{$self->{order}})
    {
        my $score = $self->{student}->{$student}->{assignment}->{$inde
+x};
        push (@return_array, $score);
    }
    return @return_array;
}

sub assignment_average
{
    my ($self, $name) = @_;
    my $index = get_index($name, @{$self->{assignment}});
    return $self->{average}->{assignment}->{$index};
}

sub catagory_names
{
    my $self = shift;
    return @{$self->{catagory}}
}

sub catagory_possible
{
    my ($self, $name) = @_;
    my $index = get_index ($name, @{$self->{catagory}});
    return $self->{possible}->{catagory}->{$index};
}

sub catagory_scores
{
    my ($self, $name) = @_;
    my @return_array;

    my $index = get_index ($name, @{$self->{catagory}});
    foreach my $student (@{$self->{order}})
    {
        my $score = $self->{student}->{$student}->{catagory}->{$index}
+;
        push (@return_array, $score);
    }
    return @return_array;
}

sub catagory_average
{
    my ($self, $name) = @_;
    my $index = get_index($name, @{$self->{catagory}});
    return $self->{average}->{catagory}->{$index};
}

sub student_assignments
{
    my ($self, $first, $last) = @_;
    my $student = $first."_".$last;
    my @return_value;
    my @keys;

    while ( my($key,$value) = each(%{$self->{student}->{$student}->{as
+signment}}) )
    {
        push (@keys, $key);
        push (@return_value, $value);
    }

    my @order;
    foreach my $assignment (@{$self->{assignment}})
    {
        for (my $i=0; $i<@keys; $i++)
        {
            my $index = get_index($assignment, @{$self->{assignment}})
+;
            push (@order, $i) if ($index == $keys[$i]);
        }
    }

    @return_value = @return_value[@order];
    return @return_value;
}

sub student_catagories
{
    my ($self, $first, $last) = @_;
    my $student = $first."_".$last;
    my @return_value;
    my @keys;

    while ( my($key,$value) = each (%{$self->{student}->{$student}->{c
+atagory}}) )
    {
        push (@keys, $key);
        push (@return_value, $value);
    }

    my @order;
    foreach my $catagory (@{$self->{catagory}})
    {
        for (my $i=0; $i<@keys; $i++)
        {
            my $index = get_index($catagory, @{$self->{assignment}});
            push (@order, $i) if ($index == $keys[$i]);
        }
    }

    @return_value = @return_value[@order];
    return @return_value;
}

sub student_total_points
{
    my ($self, $first, $last) = @_;
    my $student = $first."_".$last;

    return $self->{student}->{$student}->{total};
}

sub student_percent
{
    my ($self, $first, $last) = @_;
    my $student = $first."_".$last;

    return $self->{student}->{$student}->{percent};
}

sub student_letter
{
    my ($self, $first, $last) = @_;
    my $student = $first."_".$last;
    return $self->{student}->{$student}->{grade};
}

# subroutines for use by the module

sub get_index
{
    my ($name, @fields) = @_;
    for (my $i=0; $i<@fields; $i++)
    {
        if ($fields[$i] eq $name)
        {
            return $i+1;
        }
    }
}

"JAPH";


=head1 NAME

Gradebook

=head1 SYNOPSIS

use Gradebook;

# create a new gradbook
my $gradebook = new Gradebook;

# parse
$gradebook->parse($data);

# do stuff with the methods

=head1 DESCRIPTION

Gradebook is a module useful for parsing Gradebook Plus text reports, 
+a program used by
many K-12 school districts.  Simplely go to Reports->Gradebook of enti
+re Class->(check 
fancy report, catagory totals, and all grades)->Save to disk.  The par
+ser can then parse
the contents of this file.  Use it how you like; I use it so teachers 
+can put their grades
online with minimal effort on their part.   

=head1 METHODS

=over 4

=item parse($report)

Send it a scalar with the report to parse, in one large chunk.  The Ob
+ject becomes filled
upon using this method.

=item report_name

Returns the name of the report, if you happen want it.

=item list_students

Returns a list of students in the report.  Each element
is a reference to an anonymous hash with 3 elements:
first
last
pw
pw is a generated password which you can use, rather than
create your own.  Remember, this module was developed for
use with an online grade report system.

=item next_student

A counter of the next student in the report.
Kinda like an internal foreach loop.
Returns the next student.

=item average_percent

Returns average total percent for the class

=item average_points

Returns average total points for the class

=item total_points

Returns total possible points for the class

=item assignment_*($assignment_name)

Returns * for the given assignment name  The exception is
assignment_names, which does not take an argument and returns
a list of all assignment names.

=item catagory_*($catagory_name)

Returns * for the given catagory name  The exception is
catagory_names, which does not take an argument and returns
a list of all catagory names.

=item student_*($first, $last)

Returns * for the given student.  The exceptions are with
student_assignments and student_catagories, which return an
array of all scores in the same order as @assignment_names.

=head1 AUTHOR

Joseph F. Ryan, ryan.311@osu.edu

=cut