view Lib/IMPL/Test/Plan.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents 4d0e1962161c
children
line wrap: on
line source

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

use parent 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} = [$Unit->List];
        } otherwise {
            my $err = $@; 
            $Unit = $info{Unit} = new IMPL::Test::BadUnit(
                $Unit->can('UnitName') ?
                    $Unit->UnitName :
                    $Unit,
                "Failed to extract tests",
                $err
            );
            $info{Tests} = [$Unit->List];
        };
        $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}}) {
                my $name = $test->Name;
                
                #protected creation of the test
                $test = eval { $info->{Unit}->new($test); } || new IMPL::Test::BadUnit(
                    $info->{Unit}->can('UnitName') ?
                        $info->{Unit}->UnitName :
                        $info->{Unit},
                    "Failed to construct the test $name",
                    $@
                );
                
                # invoke the test
                $this->_Tell(RunTest => $test);
                my $result = $test->Run($data);
                $this->_Tell(EndTest => $test,$result);
                
                push @results,$result;
            }
        } else {
            my $e = $@;
            my $badTest = new IMPL::Test::BadUnit(
                $info->{Unit}->can('UnitName') ?
                    $info->{Unit}->UnitName :
                    $info->{Unit},
                "Failed to initialize the unit",
                $@
            ); 
            foreach my $test (@{$info->{Tests}}) {
                
                $this->_Tell(RunTest => $badTest);
                my $result = new IMPL::Test::Result(
                    Name => $test->Name,
                    State => IMPL::Test::Result::FAIL,
                    Exception => $e
                );
                $this->_Tell(EndTest => $badTest,$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;