view Lib/IMPL/Test/Plan.pm @ 50:521c9c1a3ea1

:q
author wizard@linux-odin.local
date Sat, 27 Feb 2010 16:28:45 +0300
parents 16ada169ca75
children 74bae30eb25e
line wrap: on
line source

package IMPL::Test::Plan;
use strict;
use warnings;

use base qw(IMPL::Object);
use IMPL::Class::Property;

use IMPL::Exception;
use IMPL::Test::Result;
use IMPL::Test::BadUnit;
use Error qw(:try);

use IMPL::Serialization;
use IMPL::Serialization::XmlFormatter;

BEGIN {
    public property Units => prop_all | prop_list;
    public property Results => prop_all | prop_list;
    public property Listeners => prop_all | prop_list;
    private property _Cache => prop_all | prop_list;
    private property _Count => prop_all;
}

sub CTOR {
    my $this = shift;
    $this->Units(\@_);
}

sub restore {
    my ($class,$data,$instance) = @_;
    
    $instance ||= $class->surrogate;
    
    $instance->callCTOR();
    
    my %args = @$data;
    
    $instance->Units($args{Units});
    $instance->Results($args{Results}) if $args{Results};
    $instance->Listeners($args{Listeners}) if $args{Listeners};
}

sub save {
    my ($this,$ctx) = @_;
    
    $ctx->AddVar(Units => [$this->Units]);
    $ctx->AddVar(Results => [$this->Results]) if $this->Results;
    $ctx->AddVar(Listeners => [$this->Listeners]) if $this->Listeners;
}

sub AddListener {
    my ($this,$listener) = @_;
    
    $this->Listeners($this->Listeners,$listener);
}

sub Prepare {
    my ($this) = @_;
    
    my $count = 0;
    my @cache;
    
    foreach my $Unit ($this->Units){
        my %info;
        
        # preload module
        undef $@;
        
        eval "require $Unit" unless (ref $Unit);
        
        # handle loading errors
        $Unit = new IMPL::Test::BadUnit($Unit,"Failed to load unit",$@) if $@;
        
        $info{Unit} = $Unit;
        try {
            $info{Tests} = [map $Unit->new($_), $Unit->List];
        } otherwise {
            $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->can('UnitName') ? $Unit->UnitName : $Unit,"Failed to extract tests",$@)];
        };
        $count += @{$info{Tests}};
        push @cache, \%info if @{$info{Tests}};
    }
    
    $this->_Count($count);
    $this->_Cache(\@cache);
}

sub Count {
    my ($this) = @_;
    return $this->_Count;
}

sub Run {
    my $this = shift;
    
    die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache;
    
    $this->_Tell(RunPlan => $this);
    
    my @resultsTotal;
    
    foreach my $info ($this->_Cache) {
        $this->_Tell(RunUnit => $info->{Unit});
        
        my $data;
        undef $@;
        eval {
            $data = $info->{Unit}->StartUnit;
        };
        
        my @results;
        
        if (not $@) {
            foreach my $test (@{$info->{Tests}}) {
                $this->_Tell(RunTest => $test);
                my $result = $test->Run($data);
                $this->_Tell(EndTest => $test,$result);
                push @results,$result;
            }
        } else {
            my $e = $@;
            foreach my $test (@{$info->{Tests}}) {
                $this->_Tell(RunTest => $test);
                my $result = new IMPL::Test::Result(
                    Name => $test->Name,
                    State => IMPL::Test::Result::FAIL,
                    Exception => $e
                );
                $this->_Tell(EndTest => $test,$result);
                push @results,$result;
            }
        }
        
        eval {
            $info->{Unit}->FinishUnit($data);
        };
        
        undef $@;
        
        push @resultsTotal, { Unit => $info->{Unit}, Results => \@results};
        
        $this->_Tell(EndUnit => $info->{Unit},\@results);
    }
    
    $this->Results(\@resultsTotal);
    $this->_Tell(EndPlan => $this);
}

sub _Tell {
    my ($this,$what,@args) = @_;
    
    $_->$what(@args) foreach $this->Listeners;
}

sub SaveXML {
    my ($this,$out) = @_;
    
    my $h;
    
    if (ref $out eq 'GLOB') {
        $h = $out;
    } elsif ($out and not ref $out) {
        open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out);
    } else {
        die new IMPL::InvalidOperationException("Invalid output specified");
    }
    
    my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
    $s->Serialize($h,$this);
}

sub LoadXML {
    my ($self,$in) = @_;
    
    my $h;
    
    if (ref $in eq 'GLOB') {
        $h = $in;
    } elsif ($in and not ref $in) {
        open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in);
    } else {
        die new IMPL::InvalidOperationException("Invalid input specified");
    }
    
    my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
    return $s->Deserialize($h);
}

sub xml {
    my $this = shift;
    my $str = '';
    
    open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream");
    $this->SaveXML($h);
    undef $h;
    return $str;
}

sub LoadXMLString {
    my $self = shift;
    my $str = shift;
    
    open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream");
    return $self->LoadXML($h);
}


1;