The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use warnings;
use strict;
use lib ('lib');
use Test::More 'no_plan';
use Petal;

$Petal::BASE_DIR     = './t/data/pass_variables';
$Petal::DISK_CACHE   = 0;
$Petal::MEMORY_CACHE = 0;
$Petal::TAINT        = 1;

my $string;
my $vars = { test => bless({}, 'Test'), foo => bless({}, 'Foo') };

$string = Petal->new( 'replace.html' )->process( $vars );
like( $string, qr/Object 0: Foo/, "foo (petal:replace)" );
like( $string, qr/Object 1: Foo/, "foo (petal:replace)" );
like( $string, qr/Object 2: Bar/, "bar (petal:replace)" );
like( $string, qr/Object 3: Foo/, "foo (?var?)" );
like( $string, qr/Object 4: Bar/, "bar (?var?)" );
#diag( $string );

$string = Petal->new( 'content.html' )->process( $vars );
like( $string, qr/Object 0: .+?Foo/, "foo (petal:content)" );
like( $string, qr/Object 1: .+?Foo/, "foo (petal:content)" );
like( $string, qr/Object 2: .+?Bar/, "bar (petal:content)" );
#diag( $string );

$string = Petal->new( 'set.html' )->process( $vars );
like( $string, qr/Object 0: Foo/, "foo (petal:set)" );
like( $string, qr/Object 1: Foo/, "foo (petal:set)" );
like( $string, qr/Object 2: Foo/, "foo (?var set:?)" );
#diag( $string );

$string = Petal->new( 'if.html' )->process( $vars );
like( $string, qr/Object 0: Foo/, "foo (petal:if)" );
like( $string, qr/Object 1: Foo/, "foo (petal:if)" );
like( $string, qr/Object 2: Foo/, "foo (?if?)" );
#diag( $string );

$string = Petal->new( 'attributes.html' )->process( $vars );
like( $string, qr/Object 0: .+?Foo/, "foo (petal:attributes)" );
like( $string, qr/Object 1: .+?Foo/, "foo (petal:attributes)" );
like( $string, qr/Object 2: .+?Bar/, "bar (petal:attributes)" );
#diag( $string );

$string = Petal->new( 'repeat.html' )->process( $vars );
like( $string, qr/Object 1: Foo/, "baz (petal:if)" );
like( $string, qr/Object 2: Foo/, "baz (petal:if)" );
#diag( $string );

$string = Petal->new( 'no_arguments.html' )->process( $vars );
like( $string, qr/No arguments passed/, "no args passed" );
#diag( $string );


package Test;
sub object_type {
    my $self = shift;
    my $obj  = shift;
    return ref($obj);
}

sub sub_test { bless {}, 'Test'; }

sub list {
    return [ shift->object_type( shift ) ];
}

sub no_arguments {
    my $self = shift;
    my $new  = bless {}, 'Test';
    $new->{no_args} = 1 unless (@_);
    return $new;
}

sub got_no_arguments {
    my $self = shift;
    return $self->{no_args};
}

package Foo;
sub bar { bless {}, 'Bar'; }