view release on metacpan or  search on metacpan

lib/HTML/Mason/Tests.pm  view on Meta::CPAN

sub _make_dirs
{
    my $self = shift;

    my $comp_root = $self->comp_root;
    my $data_dir = $self->data_dir;

    unless ( -d $self->comp_root )
    {
        $Test->diag( "Making comp_root directory: $comp_root\n" ) if $DEBUG;
        mkpath( $self->comp_root, 0, 0755 )
            or die "Unable to make base test directory '$comp_root': $!";
    }

    unless ( -d $self->data_dir )
    {
        $Test->diag( "Making data_dir directory: $data_dir\n" ) if $DEBUG;
        mkpath( $self->data_dir, 0, 0755 )
            or die "Unable to make base test directory '$data_dir': $!";
    }
}

sub base_path
{
    my $proto = shift;

    if (ref $proto)
    {
        $proto->{base_path} ||= File::Spec->catdir( cwd(), 'mason_tests', $$ );
        return $proto->{base_path};
    }
    else
    {
        return File::Spec->catdir( cwd(), 'mason_tests', $$ );
    }
}

sub comp_root
{
    my $proto = shift;

    return File::Spec->catdir( $proto->base_path, 'comps' );
}

sub data_dir
{
    my $proto = shift;

    return File::Spec->catdir( $proto->base_path, 'data' );
}

sub _write_shared_comps
{
    my $self = shift;

    return unless @SHARED;

    foreach my $comp ( @SHARED )
    {
        my @path = split m(/), $comp->{path};
        my $file = pop @path;

        my $dir = File::Spec->catdir( $self->comp_root, @path );

        $self->write_comp( $comp->{path}, $dir, $file, $comp->{component} );
    }
}

sub _write_support_comps
{
    my $self = shift;

    unless ( @{ $self->{support} } )
    {
        $Test->diag( "No support comps to create\n" ) if $DEBUG;
        return;
    }

    foreach my $supp ( @{ $self->{support} } )
    {
        my @path = split m(/), $supp->{path};
        my $file = pop @path;

        my $dir = File::Spec->catdir( $self->comp_root, $self->{name}, @path );

        $self->write_comp( $supp->{path}, $dir, $file, $supp->{component} );
    }
}

sub _write_test_comp
{
    my $self = shift;
    my $test = $self->{current_test};

    my @path = split m(/), $test->{path};
    my $file = pop @path;

    my $dir = File::Spec->catdir( $self->comp_root, $self->{name}, @path );
    unless ( -d $dir )
    {
        $Test->diag( "Making dir: $dir\n" ) if $DEBUG;
        mkpath( $dir, 0, 0755 )
            or die "Unable to create directory '$dir': $!";
    }

    $self->write_comp( $test->{path}, $dir, $file, $test->{component} );
}

sub write_comp
{
    my $self = shift;
    my ($path, $dir, $file, $component) = @_;

    unless (-d $dir)
    {
        $Test->diag( "Making dir: $dir\n" ) if $DEBUG;
        mkpath( $dir, 0, 0755 )
            or die "Unable to create directory '$dir': $!";
    }

    my $real_file = File::Spec->catfile( $dir, $file );

    $Test->diag( "Making component $path at $real_file\n" )
        if $DEBUG;

    open my $fh, ">$real_file"
        or die "Unable to write to '$real_file': $!";
    print $fh $component
        or die "Unable to write to '$real_file': $!";
    close $fh
        or die "Unable to write to '$real_file': $!";
}

sub _run_tests
{
    my $self = shift;

    my $count = scalar @{ $self->{tests} };
    $Test->plan( tests => $count );

    if ($VERBOSE)
    {
        $Test->diag( "Running $self->{name} tests ($count tests): $self->{description}\n" );
    }

    my $x = 1;
    foreach my $test ( @{ $self->{tests} } )
    {
        $self->{current_test} = $test;

        #
        # If tests_to_run or tests_to_skip were specified in the
        # environment or command line, check them to see whether to
        # run the test.
        #