|
|
@@ -38,10 +38,11 @@ use HTTP::Request;
|
|
|
use LWP::UserAgent;
|
|
|
use Data::Validate::URI qw{is_uri};
|
|
|
use List::Util 1.33;
|
|
|
+use Encode ();
|
|
|
|
|
|
=head1 CONSTRUCTOR
|
|
|
|
|
|
-=head2 B<new (api_url, user, password)>
|
|
|
+=head2 B<new (api_url, user, password, encoding, debug)>
|
|
|
|
|
|
Creates new C<TestRail::API> object.
|
|
|
|
|
|
@@ -53,7 +54,9 @@ Creates new C<TestRail::API> object.
|
|
|
|
|
|
=item STRING C<PASSWORD> - Your TestRail password, or a valid API key (TestRail 4.2 and above).
|
|
|
|
|
|
-=item BOOLEAN C<DEBUG> - Print the JSON responses from TL with your requests.
|
|
|
+=item STRING C<ENCODING> - The character encoding used by the caller. Defaults to 'UTF-8', see L<Encode::Supported> and for supported encodings.
|
|
|
+
|
|
|
+=item BOOLEAN C<DEBUG> (optional) - Print the JSON responses from TL with your requests. Default false.
|
|
|
|
|
|
=back
|
|
|
|
|
|
@@ -67,7 +70,7 @@ Does not do above checks if debug is passed.
|
|
|
=cut
|
|
|
|
|
|
sub new {
|
|
|
- my ($class,$apiurl,$user,$pass,$debug) = @_;
|
|
|
+ my ($class,$apiurl,$user,$pass,$encoding,$debug) = @_;
|
|
|
confess("Constructor must be called statically, not by an instance") if ref($class);
|
|
|
confess("Invalid URI passed to constructor") if !is_uri($apiurl);
|
|
|
$user //= $ENV{'TESTRAIL_USER'};
|
|
|
@@ -79,6 +82,7 @@ sub new {
|
|
|
pass => $pass,
|
|
|
apiurl => $apiurl,
|
|
|
debug => $debug,
|
|
|
+ encoding => $encoding || 'UTF-8',
|
|
|
testtree => [],
|
|
|
flattree => [],
|
|
|
user_cache => [],
|
|
|
@@ -90,6 +94,14 @@ sub new {
|
|
|
browser => new LWP::UserAgent()
|
|
|
};
|
|
|
|
|
|
+ #Check chara encoding
|
|
|
+ $self->{'encoding-nonaliased'} = Encode::resolve_alias($self->{'encoding'});
|
|
|
+ confess("Invalid encoding alias '".$self->{'encoding'}."' passed, see Encoding::Supported for a list of allowed encodings")
|
|
|
+ unless $self->{'encoding-nonaliased'};
|
|
|
+
|
|
|
+ confess("Invalid encoding '".$self->{'encoding-nonaliased'}."' passed, see Encoding::Supported for a list of allowed encodings")
|
|
|
+ unless grep {$_ eq $self->{'encoding-nonaliased'}} (Encode->encodings(":all"));
|
|
|
+
|
|
|
#Create default request to pass on to LWP::UserAgent
|
|
|
$self->{'default_request'} = new HTTP::Request();
|
|
|
$self->{'default_request'}->authorization_basic($user,$pass);
|
|
|
@@ -149,11 +161,11 @@ sub _doRequest {
|
|
|
|
|
|
my $coder = JSON::MaybeXS->new;
|
|
|
|
|
|
- #Data sent is JSON
|
|
|
- my $content = $data ? $coder->encode($data) : '';
|
|
|
+ #Data sent is JSON, and encoded per user preference
|
|
|
+ my $content = $data ? Encode::encode( $self->{'encoding-nonaliased'}, $coder->encode($data) ) : '';
|
|
|
|
|
|
$req->content($content);
|
|
|
- $req->header( "Content-Type" => "application/json" );
|
|
|
+ $req->header( "Content-Type" => "application/json; charset=".$self->{'encoding'} );
|
|
|
|
|
|
my $response = $self->{'browser'}->request($req);
|
|
|
|