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
|
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 |
|
---|