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;
}