view release on metacpan or  search on metacpan

lib/App/prove4air.pm  view on Meta::CPAN

package App::prove4air;
BEGIN {
  $App::prove4air::VERSION = '0.0013';
}
# ABSTRACT: Test ActionScript (.as) with prove, Adobe Air, and tap4air

use strict;
use warnings;

use Path::Class;
use File::Temp qw/ tempdir /;
use File::Copy qw/ copy /;
use IPC::System::Simple();
use Getopt::Long qw/ GetOptions :config pass_through /;

sub run {
    my $self = shift;
    my @arguments = @_;

    my ( $build_air, $run_air, $exit );
    $build_air = $ENV{ BUILD_AIR } or do {
        print STDERR <<_END_;
*** Missing \$BUILD_AIR, try:
# BUILD_AIR=\$AIR_SDK/bin/mxmlc -incremental +configname=air -compiler.source-path=src/ -debug
_END_
        $build_air = '';
        $exit = 1
    };
    $run_air = $ENV{ RUN_AIR } or do {
        print STDERR <<_END_;
*** Missing \$RUN_AIR, try:
# RUN_AIR=AIR_SDK/bin/adl
_END_
        $run_air = '';
        $exit = 1
    };

    if ( $exit ) {
        exit 64;
    }

    my ( $exec );
    $exec = $ENV{TAP_VERSION} ? 1 : 0;
    {
        local @ARGV = @arguments;
        GetOptions( exec => \$exec );
        @arguments = @ARGV;
    }

    if ( $exec ) {
        $self->test( $arguments[ 0 ],
            build_air => $build_air,
            run_air => $run_air,
        );
    }
    else {
        require App::Prove;
        my $prove = App::Prove->new;
        $prove->process_args( @arguments );
        $prove->{exec} ||= "$0 --exec";
        $prove->{extension} ||= '.t.as';
        $prove->run;
    }
}

sub test {
    my $self = shift;
    my $script = shift;
    my %context = @_;

    die "*** Missing test (.t.as) script" unless defined $script && length $script;

    $script = file $script;

    my %test;
    $test{ dir } = dir( '.t', (join '-', $script->parent->dir_list, $script->basename ) );
    $test{ dir }->mkpath;
    $test{ script }     = $test{dir}->file( 'test.as' );
    $test{ xml }        = $test{dir}->file( 'test.xml' );
    $test{ result }     = $test{dir}->file( 'result.tap' );

    my ( @content, @import_content, @test_content );
    if ( ! -s $test{ script } || $test{ script }->stat->mtime < $script->stat->mtime ) {
        @content = $script->slurp;
        if ( $content[ 0 ] =~ m/^\s*\/\/\s*!(?:tap4air|prove4air)\b/ ) {
            my $split = -1;
            my $found = 0;
            for ( @content ) {
                $split += 1;
                if ( m/^\s*\/\/\s*\-\-\-\s*$/ ) {
                    $found = 1;
                    last;
                }
            }

            if ( $found ) {
                @import_content = @content[ 1 .. $split - 1 ];
                @test_content = @content[ $split + 1 .. @content - 1 ];
            }
            else {
                @test_content = @content[ 1 .. @content - 1 ];
            }
        }

        my $xmlns;