#!/usr/bin/perl
# Script to strip internal SDL errors and memory leaks from the output of
# Valgrind.
#
# Written by DWK.

use strict;
use warnings;

my %options = (
    'strip-minuses' => 1
);

&parse_arguments();
&process_data();

sub parse_arguments {
    foreach my $arg (@ARGV) {
        foreach my $option (keys %options) {
            if($arg eq "--$option") {
                $options{$option} = 1;
            }
            elsif($arg eq "--no-$option") {
                $options{$option} = 0;
            }
            elsif($arg =~ /--$option=(\d+)$/) {
                $options{$option} = int($1);
            }
        }
    }
}

sub process_data {
    my @data = <>;
    my $name = $0;
    
    $name =~ s|^.*[/\\]||;
    
    &strip_sdl($name, @data);
    &extract_summary($name, @data);
}

sub extract_summary {
    my ($name, @data) = @_;
    
    print "SUMMARY\n";
    
    foreach my $line (@data) {
        if($line =~ /^==\d+==\s*(malloc\/free: .*)$/) {
            print "    $1\n";
        }
    }
}

sub strip_sdl {
    my ($name, @data) = @_;
    my $lastpos = -1;
    
    for(my $x = 0; $x < @data; $x ++) {
        if($data[$x] =~ /^==\d+==\s*$/ || $data[$x] =~ /^--\d+--/) {
            if($lastpos >= 0) {
                @data = &parse_section($name, $lastpos, $x, @data);
            }
            
            $lastpos = -1;
        }
        elsif($data[$x] =~ /^==\d+==    at/) {
            if($lastpos >= 0) {
                @data = &parse_section($name, $lastpos, $x - 1, @data);
            }
            
            $lastpos = $x - 1;
        }
    }
    
    &print_data(@data);
}

sub print_data {
    my @data = @_;
    
    foreach my $line (@data) {
        if($line =~ /^--\d+--/ && $options{'strip-minuses'} == 1) {
            next;
        }
        
        print $line;
    }
}

sub parse_section {
    my ($name, $start, $end, @data) = @_;
    my $funcs = '(__|_X|SDL_(Init|Quit|LoadObject|LoadFunction|VideoInit))';
    my $x = 0;
    
    for($x = $start; $x < $end; $x ++) {
        if($data[$x] =~ /^==\d+==    by 0x[\d\w]+: $funcs/) {
            last;
        }
    }
    
    if($x < $end) {
        if($start) {
            if($data[$start - 1] =~ /^==\d+==\s*$/) {
                $data[$start - 1] = '';
            }
            elsif($data[$start - 1]
                =~ /^==\d+== \d+ errors in context \d+ of \d+:$/) {
                
                $start --;
                $data[$start] =~ s/^==\d+==\s*//;
                $data[$start] = "HEAD:  $data[$start]";
                $start ++;
            }
        }
        
        $data[$start] =~ s/^==\d+==\s*//;
        $data[$start] = "STRIP: $data[$start]";
        $start ++;
        
        if($end < @data && $data[$end] =~ /^==\d+==\s*$/) {
            $data[$end] = '';
        }
        
        do {
            $data[$start] = '';
        } while(++$start != $end);
    }
    
    return @data;
}

...
STRIP: 368 bytes in 1 blocks are still reachable in loss record 41 of 64
STRIP: 408 bytes in 1 blocks are still reachable in loss record 42 of 64
STRIP: 480 bytes in 4 blocks are still reachable in loss record 43 of 64
STRIP: 624 bytes in 7 blocks are still reachable in loss record 44 of 64
STRIP: 702 bytes in 54 blocks are still reachable in loss record 45 of 64
STRIP: 802 bytes in 88 blocks are still reachable in loss record 46 of 64
==10304==
==10304== 840 bytes in 1 blocks are still reachable in loss record 47 of 64
==10304==    at 0x4C216F4: calloc (vg_replace_malloc.c:397)
==10304==    by 0x571F62B: _mxml_global (in /usr/lib/libmxml.so.1.4)
==10304==    by 0x571BD6A: mxmlSetErrorCallback (in /usr/lib/libmxml.so.1.4)
==10304==    by 0x46F410: Callis::Resource::ResourceFile::ResourceFile(std::stri
ng) (ResourceFile.cpp:23)
==10304==    by 0x46C178: Callis::Resource::UniverseParserWrapper::UniverseParse
rWrapper(std::string, std::string) (UniverseParser.h:44)
==10304==    by 0x468CEA: main (RoleplayMain.cpp:19)
==10304==
STRIP: 880 bytes in 55 blocks are still reachable in loss record 48 of 64
STRIP: 1,024 bytes in 1 blocks are still reachable in loss record 49 of 64
STRIP: 1,092 bytes in 91 blocks are still reachable in loss record 50 of 64
STRIP: 1,117 bytes in 55 blocks are still reachable in loss record 51 of 64
STRIP: 1,341 bytes in 91 blocks are still reachable in loss record 52 of 64
...