Test::Parser - Base class for parsing log files from test runs, and

 use Test::Parser::MyTest;

 my $parser = new Test::Parser::MyTest;
 $parser->parse($text) 
    or die $parser->error(), "\n";
 printf("Num Errors:    %8d\n", $parser->num_errors());
 printf("Num Warnings:  %8d\n", $parser->num_warnings());
 printf("Num Executed:  %8d\n", $parser->num_executed());
 printf("Num Passed:    %8d\n", $parser->num_passed());
 printf("Num Failed:    %8d\n", $parser->num_failed());
 printf("Num Skipped:   %8d\n", $parser->num_skipped());

 printf("\nErrors:\n");
 foreach my $err ($parser->errors()) {
     print $err;
 }

 printf("\nWarnings:\n");
 foreach my $warn ($parser->warnings()) {
     print $warn;
 }

 print $parser->to_xml();

    Purpose: To find individual key values parsed from test results
    Input: The search key, the 'datum' the key is stored in
    Output: Data stored under the search key, or the search key if not found

    * A text string
    * A filename of an external log file to parse
    * An open file handle (e.g. \*STDIN)

    my @logs;
    open (FILE, 'my.log') or die "Couldn't open: $!\n";
    while (FILE) {
        my $parser = new Test::Parser;
        $parser->parse(\*FILE);
        push @logs, $parser;
    }
    close (FILE) or die "Couldn't close: $!\n";

package Test::Parser;

use strict;
use warnings;
use File::Basename;

use fields qw(
              code-convention-report
              coverage-report
              test
              num-datum
              num-column
              build
              root
              url
              release
              vendor
              license
              summary
              description
              platform
              kernel
              version
              testname
              type
              path
              name
              units
              warnings
              errors
              testcases
              num_passed
              num_failed
              num_skipped
              outdir
              format
              _debug
              );

use vars qw( %FIELDS $VERSION );
our $VERSION = '1.7';
use constant END_OF_RECORD => 100;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = bless {%FIELDS}, $class;

    $self->{path}          = 0;
    $self->{units}         = $class;
    $self->{version}       = $class;
    $self->{type}          = 'unit';
    $self->{warnings}      = [];
    $self->{errors}        = [];
    $self->{testcases}     = [];
    $self->{num_passed}    = 0;
    $self->{num_failed}    = 0;
    $self->{num_skipped}   = 0;
    $self->{outdir}        = '.';
    $self->{format}        = 'png';
    $self->{_debug}	   = 0;
    $self->{name}          = "";
    $class=~s/^Test::Parser:://;
    $self->{'testname'}    = $class;
    $self->{'num-column'}    = 0;
    $self->{'num-datum'}     = 0;
    $self->{build}         = 0;
    $self->{root}          = 0;
    $self->{release}       = 0;
    $self->{url}           = 0;
    $self->{vendor}        = 0;
    $self->{license}       = 0;
    $self->{summary}       = 0;
    $self->{description}   = 0;
    $self->{platform}      = 0;
    $self->{kernel}        = 0;
    $self->{'coverage-report'}=0;
    $self->{'code-convention-report'}=0;   
 
    return $self;
}

sub name {
    my $self = shift;
    my $my_name = shift;

    if ($my_name) {
        $self->{name} = $my_name;
    }

    return $self->{name};
}

sub testname {
    my $self = shift;
    my $testname = shift;

    if ($testname) {
        $self->{testname} = $testname;
    }

    return $self->{testname};
}

sub version {
    my $self = shift;
    my $version = shift;

    if ( $version ) {
        $self->{version} = $version;
    }

    return $self->{version};
}

sub units {
    my $self = shift;
    my $units = shift;

    if ( $units ) {
        $self->{units} = $units;
    }

    return $self->{units};
}

sub to_xml {
    my $self = shift;
    my $xml = "";
    my $data = $self->data();
    my @required = qw(testname version description summary license vendor release url platform);
    my @fields   = qw(testname version description summary license vendor release url platform kernel root build coverage-report code-convention-report);

    foreach my $field (@required) {
        if( !$self->{$field} ) {
            print "Missing required field: $field\n";
            return undef;
        }
    }
    $xml .= qq|<component name='$self->{testname}' version='$self->{version}'>\n|;
    foreach my $field (@fields) {
        if ($self->{$field}) {
            #Special case for build / status
            if ($field eq 'build' && $self->{build_status}) {
                $xml .= qq| <build status='$self->{build_status}'>$self->{build}</build>\n|;
            }
            else {
                $xml .= qq| <$field>$self->{$field}</$field>\n|;
            }
        }
    }
    if( $self->{test} ){
        $xml .= qq| <test|;
        if( $self->{test}->{'log-filename'} ){
            $xml .= qq| log-filename=$self->{test}->{'log-filename'}|;
        }
        if( $self->{test}->{path} ){
            $xml .= qq| path=$self->{test}->{path}|;
        }
        if( $self->{test}->{'suite-type'} ){
            $xml .= qq| suite-type=$self->{test}->{'suite-type'}>\n|;
        }    
        else {
            $xml .= qq|>\n|;
        }
        if( $self->{test}->{data} ){
            $xml .= qq|  <data>\n|;
            if( $self->{test}->{data}->{columns} ){
                $xml .= qq|   <columns>\n|;

                my %column_hash=%{$self->{test}->{data}->{columns}};
                foreach my $column_key(sort {$a <=> $b} keys %column_hash){
                    if( $column_hash{$column_key}->{'name'} ){       
                        $xml .= qq|    <c id="$column_key" name="$column_hash{$column_key}->{'name'}"|;
                    }
                    if( $column_hash{$column_key}->{units} ){
                        $xml .= qq| units="$column_hash{$column_key}->{units}"|;
                    }
                    $xml .= qq|/>\n|;
                }
                $xml .= qq|   </columns>\n|;
            }
            if( $self->{test}->{data}->{datum} ){
                my %datum_hash=%{ $self->{test}->{data}->{datum} };                 
                foreach my $datum_key( sort {$a <=> $b} keys %datum_hash ){
                    $xml .= qq|   <datum id="$datum_key">\n|;
                    foreach my $key_val( sort {$a <=> $b} keys %{ $datum_hash{$datum_key} }){
                        if( $key_val ){
                            $xml .= qq|    <d id="$key_val">|;
                            if( $self->{test}->{data}->{datum}->{$datum_key}->{$key_val} ){
                                $xml .= qq|$self->{test}->{data}->{datum}->{$datum_key}->{$key_val}|;
                            }
                            $xml .= qq|</d>\n|;
                        }
                    }
                    $xml .= qq|   </datum>\n|;
                }       
            }
            $xml .= qq|  </data>\n|;
        }
        $xml .= qq| </test>\n|;
    }
    $xml .= qq|</component>\n|;
    return $xml;
}

sub add_column { 
    my $self=shift;
    my $name=shift;
    my $units=shift;
    $self->{'num-column'}+=1;
    my $columnId = $self->{'num-column'};
    $self->{test}->{data}->{columns}->{$columnId}->{name}=$name;
    $self->{test}->{data}->{columns}->{$columnId}->{units}=$units;
    return $columnId;
}

sub add_data {
    my $self = shift;
    my $val = shift;
    my $col = shift;
    my $temp = 1;
    
    if ( defined($self->{'num-datum'}) ) {
        $temp += $self->{'num-datum'};
    }

    for(my $dumy=1; $dumy<($self->{'num-column'}+1); $dumy+=1){
        $self->{test}->{data}->{datum}->{$temp}->{$col}= $val;
    }
    return;
}

sub inc_datum {
    my $self = shift;
    if ( defined($self->{'num-datum'}) ) {
        $self->{'num-datum'} += 1;
    }
    else {
        $self->{'num-datum'} = 1;
    }
    return $self->{'num-datum'};
}

sub to_dump {
    my $self = shift;

    require Data::Dumper;
    print Data::Dumper->Dumper($self->{test});
}

sub num_data {
    my $self =shift;
    if (@_) {
        $self->{num_columns} = @_;
    }
    return $self->{num_columns};
}

sub build {
    my $self =shift;
    if (@_) {
        $self->{build} = @_;
    }
    return $self->{build};
}

sub root {
    my $self =shift;
    if (@_) {
        $self->{root} = @_;
    }
    return $self->{root};
}
sub url {
    my $self =shift;
    if (@_) {
        $self->{url} = @_;
    }
    return $self->{url};
}

sub release {
    my $self =shift;
    if (@_) {
        $self->{release} = @_;
    }
    return $self->{release};
}

sub vendor {
    my $self =shift;
    if (@_) {
        $self->{vendor} = @_;
    }
    return $self->{vendor};
}

sub license {
    my $self =shift;
    if (@_) {
        $self->{license} = @_;
    }
    return $self->{license};
}

sub summary {
    my $self =shift;
    if (@_) {
        $self->{summary} = @_;
    }
    return $self->{summary};
}

sub description {
    my $self =shift;
    if (@_) {
        $self->{description} = @_;
    }
    return $self->{description};
}

sub platform {
    my $self =shift;
    if (@_) {
        $self->{platform} = @_;
    }
    return $self->{platform};
}

sub type {
    my $self =shift;
    if (@_) {
        $self->{type} = @_;
    }
    return $self->{type};
}

sub set_debug {
    my $self = shift;

    if (@_) {
        $self->{_debug} = shift;
    }

    return $self->{_debug};
}

sub type_2 {
    my $self =shift;
    if (@_) {
        $self->{type} = @_;
    }
    return $self->{type};
}

sub path {
    my $self =shift;
    if (@_) {
        $self->{path} = @_;
    }
    return $self->{path};
}

sub warnings {
    my $self = shift;
    if (@_) {
        $self->{warnings} = shift;
    }
    $self->{warnings} ||= [];
    return $self->{warnings};
}

sub num_warnings {
    my $self = shift;
    return 0 + @{$self->warnings()};
}

sub errors {
    my $self = shift;
    if (@_) {
        $self->{errors} = shift;
    }
    $self->{errors} ||= [];
    return $self->{errors};
}

sub num_errors {
    my $self = shift;
    return 0 + @{$self->errors()};
}

sub testcases {
    my $self = shift;
    if (@_) {
        $self->{testcases} = shift;
    }
    $self->{testcases} ||= [];
    return $self->{testcases};
}

sub num_executed {
    my $self = shift;
    return 0 + @{$self->testcases()};
}

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

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

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

sub format {
    my $self = shift;
    if (@_) {
        $self->{format} = shift;
    }
    return $self->{format};
}

sub outdir {
    my $self = shift;
    if (@_) {
        $self->{outdir} = shift;
    }
    return $self->{outdir};
}

sub get_key {
    my $self = shift;
    my $key = shift or warn ("No search key specified");
    my $datum_id = shift or warn ("No datum id specified");

    my $col_id = undef;
    
    foreach my $id ( keys %{ $self->{test}->{data}->{columns} } ) {
        my $check_key = $self->{test}->{data}->{columns}->{$id}->{name};
        
        if( $self->{test}->{data}->{columns}->{$id}->{name} eq $key ) {
            $col_id = $id;
        }
    }
    
    if (defined($col_id)) {
        return $self->{test}->{data}->{datum}->{$datum_id}->{$col_id}
    }
    else {
        warn ("Unable to find key: " . $key . "\n");
        return $key;
    }
}

sub parse {
    my $self = shift;
    my $input = shift or return undef;
    my ($name, $path) = @_;

    my $retval = 1;

    # If it's a GLOB, we're probably reading from STDIN
    if (ref($input) eq 'GLOB') {
        while (<$input>) {
            $retval = $self->parse_line($_) || $retval;
            last if $retval == END_OF_RECORD;
        }
    }
    # If it's a scalar and has newlines, it's probably the full text
    elsif (!ref($input) && $input =~ /\n/) {
        my @lines = split /\n/, $input;
        while (shift @lines) {
            $retval = $self->parse_line($_) || $retval;
            last if $retval == END_OF_RECORD;
        }
    }

    # If it appears to be a valid filename, assume we're reading an external file
    elsif (!ref($input) && -f $input) {
        $name ||= basename($input);
        $path ||= dirname($input);

        open (FILE, "< $input")
            or warn "Could not open '$input' for reading:  $!\n"
            and return undef;
        while (<FILE>) {
            $retval = $self->parse_line($_) || $retval;
            last if $retval eq END_OF_RECORD;
        }
        close(FILE);
    }
    $self->{path} = $path;

    return $retval;
}

sub parse_line {
    my $self = shift;
    my $text = shift or return undef;

    return undef;
}

1;