view Lib/IMPL/Test/Plan.pm @ 245:7c517134c42f

Added Unsupported media type Web exception corrected resourceLocation setting in the resource Implemented localizable resources for text messages fixed TT view scopings, INIT block in controls now sets globals correctly.
author sergey
date Mon, 29 Oct 2012 03:15:22 +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;