#!/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;
}