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
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.