The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;
use v5.10.1;
use Test::More;
use Test::Exception;
use Test::LWP::UserAgent;
use HTTP::Response;

my $pkg;

BEGIN {
    $pkg = 'Catmandu::Importer';
    use_ok $pkg;
}
require_ok $pkg;

{

    package T::Importer;
    use Moo;
    with $pkg;

    sub generator {
        my ($self) = @_;
        sub {
            state $fh = $self->fh;
            my $name = $self->fh->getline;
            return defined $name ? {"hello" => $name} : undef;
        };
    }

    package T::DataPathImporter;
    use Moo;
    with $pkg;

    sub generator {
        my ($self) = @_;
        sub {
            state $data = [
                {abc => [{a => 1}, {b => 2}, {c => 3}]},
                {abc => [{d => 4}, {e => 5}, {f => 6}]}
            ];
            return shift @$data;
        };
    }
}

my $i = T::Importer->new;
ok $i->does('Catmandu::Iterable');

$i = T::Importer->new(file => \"World");
is_deeply $i->to_array, [{hello => "World"}], 'import from string reference';

$i = T::Importer->new(file => \"Hello\nWorld");
is join('', $i->fh->getlines), "Hello\nWorld", "import all";

$i = T::Importer->new(file => "missing");
throws_ok {$i->fh->getlines} "Catmandu::BadArg",
    "throws an error if file doesn't exist";

$i = T::DataPathImporter->new;
is_deeply $i->to_array,
    [
    {abc => [{a => 1}, {b => 2}, {c => 3}]},
    {abc => [{d => 4}, {e => 5}, {f => 6}]}
    ];
$i = T::DataPathImporter->new(data_path => 'abc');
is_deeply $i->to_array,
    [[{a => 1}, {b => 2}, {c => 3}], [{d => 4}, {e => 5}, {f => 6}]];
$i = T::DataPathImporter->new(data_path => 'abc.*');
is_deeply $i->to_array,
    [{a => 1}, {b => 2}, {c => 3}, {d => 4}, {e => 5}, {f => 6}];

$i = T::Importer->new(user_agent => user_agent(), file => 'http://demo.org/');
is join('', $i->fh->getlines), "test123", "read from http (file)";

$i = T::Importer->new(
    user_agent => user_agent(),
    file       => 'http://demo.org/{id}',
    variables  => {id => 1234}
);
is $i->file, "http://demo.org/1234";
is join('', $i->fh->getlines), "test1234",
    "read from http (file + variables)";

$i = T::Importer->new(
    user_agent => user_agent(),
    file       => 'http://demo.org/{1},{2},{3}',
    variables  => [qw(red green blue)]
);
is $i->file, "http://demo.org/red,green,blue";
is join('', $i->fh->getlines), "RED-GREEN-BLUE",
    "read from http (file + variables list)";

$i = T::Importer->new(
    user_agent => user_agent(),
    file       => 'http://demo.org/{1},{2},{3}',
    variables  => "red,green,blue"
);
is $i->file, "http://demo.org/red,green,blue";
is join('', $i->fh->getlines), "RED-GREEN-BLUE",
    "read from http (file + variables list)";

$i = T::Importer->new(
    user_agent  => user_agent(),
    file        => 'http://demo.org/post',
    http_method => 'POST',
    http_body   => '=={id}==',
    variables   => {id => 1234}
);
is $i->file, "http://demo.org/post";
is join('', $i->fh->getlines), "POST",
    "read from http (file + variables list + post request)";

$i = T::Importer->new(
    user_agent  => user_agent(),
    file        => 'http://demo.org/post',
    http_method => 'POST',
    http_body   => '=={id}==',
    variables   => "red,green,blue"
);
is $i->file, "http://demo.org/post";
is join('', $i->fh->getlines), "POST",
    "read from http (file + variables list + post request)";

$i = T::Importer->new(
    user_agent  => user_agent(),
    file        => 'http://demo.org/not-exsists',
    http_method => 'POST',
    http_body   => '=={id}==',
    variables   => "red,green,blue"
);

throws_ok {$i->fh->getlines} 'Catmandu::HTTPError',
    "throws an error on non-existing pages";

$i = T::Importer->new(file => 'http://demo.org');

is ref($i->_http_client), 'LWP::UserAgent', 'Got a real client';

done_testing;

sub user_agent {
    my $ua = Test::LWP::UserAgent->new(agent => 'Test/1.0');

    $ua->map_response(
        qr{^http://demo.org/$},
        HTTP::Response->new(
            '200', 'OK', ['Content-Type' => 'text/plain'], 'test123'
        )
    );

    $ua->map_response(
        qr{^http://demo.org/1234$},
        HTTP::Response->new(
            '200', 'OK', ['Content-Type' => 'text/plain'], 'test1234'
        )
    );

    $ua->map_response(
        qr{^http://demo.org/red,green,blue$},
        HTTP::Response->new(
            '200', 'OK',
            ['Content-Type' => 'text/plain'], 'RED-GREEN-BLUE'
        )
    );

    $ua->map_response(
        qr{^http://demo.org/post$},
        HTTP::Response->new(
            '200', 'OK', ['Content-Type' => 'text/plain'], 'POST'
        )
    );

    $ua;
}