Can't send HTTP response as xml using mojolicious - perl

Trying to learn Mojolicious here. For the following request, I get 404 when I try to get to
http://hostname:3000/xml
Here is the simple script:
use Mojolicious::Lite;
use Data::Dumper;
get '/xml' => sub {
my $self = shift;
$self->render(xml => "<employees>
<employee>
<id>1001</id>
<name>John Smith</name>
</employee>
<employee>
<id>1002</id>
<name>Jane Dole</name>
</employee>
</employees>"
);
};
app->start;
This script was adopted from an example for json, which works fine. Not sure why xml doesn't work.

Just need to specify a format
get '/xml' => sub {
my $self = shift;
my $xml = <<'XML';
<employees>
<employee><id>1001</id><name>John Smith</name></employee>
<employee><id>1002</id><name>Jane Dole</name></employee>
</employees>
XML
$self->render(data => $xml, format => 'xml');
};
Response header equals the following:
Connection: keep-alive
Server: Mojolicious (Perl)
Content-Length: 140
Content-Type: application/xml
Date: Wed, 09 Apr 2014 05:36:05 GMT
200 OK
Could also place the data in a template, of course:
get '/xml' => sub {
my $self = shift;
$self->render('employees', format => 'xml');
};
app->start;
__DATA__
## employees.xml.ep
<employees>
<employee><id>1001</id><name>John Smith</name></employee>
<employee><id>1002</id><name>Jane Dole</name></employee>
</employees>

Related

How to prevent serialisation in one route in a perl dancer app?

I 've got a perl dancer app (providing a rest api) which works fine with JSON (de-)serialization.
Now I'm need one additional special route, that provides a (dynamically created) csv file for download.
Here is the sample code:
#!/usr/bin/env perl
use Dancer2;
set serializer => 'JSON';
get '/normal' => sub {
{ 'I say ' => 'the json serializer works' };
};
get '/download' => sub {
content_type 'text/csv';
return generateCsv();
};
sub generateCsv {
return '
1,2,3
4,5,6
';
}
dance;
The response sent to the client has no body, only a http-header (with the correct content-type)
$> curl -I http://localhost:3000/download
HTTP/1.0 200 OK
Date: Fri, 23 Mar 2018 10:10:14 GMT
Server: Perl Dancer2 0.205002
Server: Perl Dancer2 0.205002
Content-Length: 0
Content-Type: text/csv
The dancer serializer is not happy with this:
Failed to serialize content: hash- or arrayref expected
(not a simple scalar, use allow_nonref to allow this)
at /usr/local/share/perl/5.22.1/Dancer2/Serializer/JSON.pm line 40.
in /usr/local/share/perl/5.22.1/Dancer2/Core/Response.pm
I can't find anything about the allow_nonref thing in the Dancer docs or in the source code.
Has anybody a hint for me?
Use send_as:
get '/download' => sub {
send_as Mutable => generateCsv();
};
I've found that send_file also works:
get '/download' => sub {
send_file (\&generateCsv(), content_type => 'text/csv', filename => 'articleEbayStatus.csv');
};

Perl REST integration with Salesforce Report

I am integrating Perl with Salesforce Reports. I am trying to connect Perl script through standard REST API (/00O93000009NpOy?export=1&enc=UTF-8&xf=csv) of Salesforce Report and getting response code 200. In high level I need to download the Salesforce report in Excel format using a Perl script.
Please look into my code:
#!/usr/bin/perl
use warnings;
use strict;
use WWW::Mechanize;
use WWW::Salesforce;
use REST::Client;
# Authenticate first via SOAP interface to get a session ID:
my $sforce = eval { WWW::Salesforce->login(
'username' => "USER_NAME",
'password' => "PASSWORD" ); };
die "Could not login to SFDC: $#" if $#;
# Get the session ID:
my $hdr = $sforce->get_session_header();
my $sid = ${$hdr->{_value}->[0]}->{_value}->[0];
my $host = 'https://ap1.salesforce.com';
my $client = REST::Client->new(host => $host);
# Get ALL incidents
$client->GET('/00O93000009NpOy?export=1&enc=UTF-8&xf=csv',
{'Authorization' => "OAuth $sid",
'Accept' => 'application/json'});
print 'Response: ' . $client->responseContent() . "\n";
print 'Response status: ' . $client->responseCode() . "\n";
foreach ( $client->responseHeaders() ) {
print 'Header: ' . $_ . '=' . $client->responseHeader($_) . "\n";
}
And when I ran this Perl code through command prompt then I got response like this:
C:\Users\Documents>perl TEST.pl`enter code here`
Response:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.or
g/TR/html4/loose.dtd">
<html>
<head>
<meta HTTP-EQUIV="PRAGMA" CONTENT="NO-CACHE">
<script>
if (this.SfdcApp && this.SfdcApp.projectOneNavigator) { SfdcApp.projectOneNaviga
tor.handleRedirect('https://login.salesforce.com/?ec=302&startURL=%2F00O90000009
NhOy%3Fenc%3DUTF-8%26export%3D1%26xf%3Dcsv'); } else
if (window.location.replace){
window.location.replace('https://login.salesforce.com/?ec=302&startURL=%2F00O900
00009NhOy%3Fenc%3DUTF-8%26export%3D1%26xf%3Dcsv');
} else {;
window.location.href ='https://login.salesforce.com/?ec=302&startURL=%2F00O90000
009NhOy%3Fenc%3DUTF-8%26export%3D1%26xf%3Dcsv';
}
</script>
</head>
</html>
<!-- Body events -->
<script type="text/javascript">function bodyOnLoad(){if(window.PreferenceBits){w
indow.PreferenceBits.prototype.csrfToken="null";};}function bodyOnBeforeUnload()
{}function bodyOnFocus(){}function bodyOnUnload(){}</script>
</body>
</html>
<!--
................................................................................
...................
................................................................................
...................
................................................................................
...................
................................................................................
...................
-->
Response status: 200
Header: Connection=close
Header: Date=Tue, 29 Nov 2016 10:05:43 GMT
Header: Pragma=NO-CACHE
Header: Content-Type=text/html;charset=UTF-8
Header: Client-Date=Tue, 29 Nov 2016 10:05:43 GMT
Header: Client-Peer=182.50.78.41:443
Header: Client-Response-Num=1
Header: Client-SSL-Cert-Issuer=/C=US/O=Symantec Corporation/OU=Symantec Trust Ne
twork/CN=Symantec Class 3 Secure Server CA - G4
Header: Client-SSL-Cert-Subject=/C=US/ST=California/L=San Francisco/O=Salesforce
.com, Inc/OU=Applications/CN=*.salesforce.com
Header: Client-SSL-Cipher=ECDHE-RSA-AES256-GCM-SHA384
Header: Client-SSL-Socket-Class=IO::Socket::SSL
Header: Set-Cookie=BrowserId=UGPsAKnYTgWN3JcU4kcKxg;Path=/;Domain=.salesforce.co
m;Expires=Sat, 28-Jan-2017 10:05:43 GMT
Although response should be in JSON format and not absurd. I tried with workbench and getting the response in JSON format that is good. The response is not proper.
In order to get the json of your report try the following:
$client->GET('https://<server name>.salesforce.com/services/data/v35.0/analytics/reports/<report id>',
{'Authorization' => "OAuth $sid",
'Accept' => 'application/json'});
This worked for me.

Snooping on http headers between different plack middlewares

If I understand right, the PSGI application works as next:
got the request from a browser
the request is "bubbles" thru some middlewares in the order as them is defined in the builder
the request comes to my app
my app produces some respond
this respond again bubbles thru some middlewares
finally the respon is send to the browser
I can easily debug-print all headers (e.g. cookies) when the request landed in my $app.
The question is:
How to debug-print the actual state of headers while the request coming thru many middlewares to my app and while the respond is going-out again thru middlewares.
So, Having an (simplyfied) app.psgi, like the next:
use strict;
use warnings;
use Plack::Builder;
my $app = sub { ... };
builder {
# <- debug-print the first request headers
# and the last respond headers here
enable "Debug";
# <- debug-print the actual state of request/respond headers here
enable "mid2";
# <- and here
enable "mid3";
# <- and here
$app; # <- and finally here - this is of course EASY
}
It is probably not as easy as something like,
print STDERR Dumper $dont_know_what->request->headers(); #HTTP::Headers ???
print STDERR Dumper $dont_know_what->respond->headers();
so adding a bounty :) ;)
One basic approach is to create a middleware that dumps the headers before executing the wrapped application and then right afterward. Then you enable this middleware at each point where you want to see the headers as you have pointed out in your pseudocode.
The following code does this by building an in-line middleware each time you enable it.
use Plack::Builder;
use Plack::Request;
use Plack::Response;
sub headers_around {
my $position = shift;
# build and return the headers_around middleware as a closure
return sub {
my $app = shift;
# gets called each request
return sub {
my $env = shift;
my $req = Plack::Request->new($env);
# display headers before next middleware
print STDERR "req headers before $position:\n" . $req->headers->as_string . "\n=====\n";
# execute the next app on the stack
my $res = $app->($env);
my $response = Plack::Response->new(#$res);
# display headers after previous middleware
print STDERR "res headers after $position:\n" . $response->headers->as_string . "\n=====\n";
return $res;
};
};
};
builder {
enable headers_around('Debug');
enable 'Debug';
enable headers_around('Lint');
enable 'Lint';
enable headers_around('StackTrace');
enable 'StackTrace', force => 1;
enable headers_around('App');
mount '/' => builder { sub {
return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello World' ] ];
}}
};
# now build the application enabling regular middleware with our inline middleware
builder {
enable headers_around('Debug');
enable 'Debug';
enable headers_around('Lint');
enable 'Lint';
enable headers_around('StackTrace');
enable 'StackTrace', force => 1;
enable headers_around('App');
mount '/' => builder { sub {
return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello World' ] ];
}}
};
When I run it with plackup I get the following output:
$ plackup --app between_middleware.psgi
HTTP::Server::PSGI: Accepting connections at http://0:5000/
req headers before Debug:
Connection: Keep-Alive
Accept: */*
Host: 0:5000
User-Agent: Wget/1.12 (linux-gnu)
=====
req headers before Lint:
Connection: Keep-Alive
Accept: */*
Host: 0:5000
User-Agent: Wget/1.12 (linux-gnu)
=====
req headers before StackTrace:
Connection: Keep-Alive
Accept: */*
Host: 0:5000
User-Agent: Wget/1.12 (linux-gnu)
=====
req headers before App:
Connection: Keep-Alive
Accept: */*
Host: 0:5000
User-Agent: Wget/1.12 (linux-gnu)
=====
res headers after App:
Content-Type: text/plain
=====
res headers after StackTrace:
Content-Type: text/plain
=====
res headers after Lint:
Content-Type: text/plain
=====
res headers after Debug:
Content-Type: text/plain
=====
127.0.0.1 - - [02/Apr/2014:19:37:30 -0700] "GET / HTTP/1.0" 200 11 "-" "Wget/1.12 (linux-gnu)"
Obviously you could turn this into an actual middleware like Ashley's and you may have to tweak it to send log messages using whatever facility you have in place.
Middleware
package ShowMeTheHeaders;
use parent "Plack::Middleware";
use Plack::Request;
use Plack::Response
require Text::Wrap;
my $_call_back = sub {
my $response = Plack::Response->new(#{+shift});
print "* Response Headers:\n",
Text::Wrap::wrap("\t", "\t", $response->headers->as_string);
return; # Explicit return suggested by docs.
};
sub call {
my $self = shift;
my $request = Plack::Request->new(shift);
print "* Request Headers:\n",
Text::Wrap::wrap("\t", "\t", $request->headers->as_string);
my $response = $self->app->($request);
Plack::Util::response_cb($response, $_call_back);
}
1;
You can do this without the objectification (Plack::Request and Plack::Response) but then you have to deal with raw attributes and keys for the header fields instead of the entirely more pleasant ->as_string. See also the “response callback” section of Plack::Middleware.
demo psgi
use warnings;
use strict;
use Plack::Builder;
my $app = sub {
[ 200,
[ "Content-Type" => "text/plain" ],
[ "O HAI, PLAK!" ]
];
};
builder {
enable "+ShowMeTheHeaders";
mount "/" => $app;
};

Perl script not saving cookies on google chrome?

i am trying to learn to work with cookies using Perl. following is my code. but i dont know why the cookie is not getting saved in chrome. everytime i run this script a new cookie is created.
#!"C:\wamp\perl\bin\perl.exe" -w
print "Content-type: text/html\n\n";
use CGI::Carp qw( fatalsToBrowser );
use CGI;
my $q=new CGI;
$value=$q->cookie('lol');
$cookie=$q->cookie
(
-name=>'lol',
-value=>'gh',
-expires=>'+7d'
);
print $q->header(-cookie=>$cookie);
$q->start_html
(
-title=>'CGI.pm Cookies'
);
unless($value) {print "cookie is goint to set";}
else {print "Hi $value";}
$q->end_html;
exit;
Here's the output of your script:
Content-type: text/html
Set-Cookie: lol=gh; path=/; expires=Sat, 04-May-2013 11:16:12 GMT
Date: Sat, 27 Apr 2013 11:16:12 GMT
Content-Type: text/html; charset=ISO-8859-1
cookie is goint to set
You send the Content-Type response header twice: first, on line 2, and again on line 16 when you print $q->header(-cookie => $cookie).
In fact, the double newline on line 2 ends your HTTP headers. So the output of $q->header(-cookie => $cookie) will be treated as document body content, not as HTTP headers.
Quickest solution? Comment out line 2.
Your forgot to send your cookie to the client:
print header(-cookie=>$cookie);

How to suppress the default mod_perl error page in legacy CGI script using ModPerl::Registry

I have a CGI script in Perl that generates HTTP error pages by itself. I am running it under mod_perl via ModPerl::Registry, using the following Apache2 configuration:
Alias /perl "/var/www/perl"
<Directory "/var/www/perl">
SetHandler perl-script
PerlResponseHandler ModPerl::Registry
PerlOptions +ParseHeaders
Options Indexes FollowSymlinks +ExecCGI
AllowOverride None
Order allow,deny
Allow from all
</Directory>
Everything is fine, except a little problem: when HTTP status printed in headers is different than 200 (for instance 404), Apache appends a default HTML error document to my own generated response.
Take for example the following simple CGI script:
#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard :escapeHTML -nosticky);
use CGI::Carp qw(fatalsToBrowser);
use Apache2::Const qw(:http :common);
our $cgi = CGI->new();
print $cgi->header(-type=>'text/html', -charset => 'utf-8',
-status=> '404 Not Found');
our $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
print <<"EOF";
<html>
<head>
<title>die_error_minimal$mod_perl_version
</head>
<body>
404 error
</body>
</html>
EOF
exit;
Running it with Apache configuration mentioned above results in
HTTP/1.1 404 Not Found
Date: Sun, 27 Nov 2011 13:17:59 GMT
Server: Apache/2.0.54 (Fedora)
Connection: close
Transfer-Encoding: chunked
Content-Type: text/html; charset=utf-8
<html>
<head>
<title>die_error_minimal mod_perl/2.0.1
</head>
<body>
404 error
</body>
</html>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>404 Not Found</title>
</head><body>
<h1>Not Found</h1>
<p>The requested URL /perl/die_error_minimal.cgi was not found on this server.</p>
<hr>
<address>Apache/2.0.54 (Fedora) Server at localhost Port 80</address>
</body></html>
Note that replacing exit; in the example CGI script above with either return Apache2::Const::OK; or return Apache2::Const::DONE;, as recommended in "How do I suppress the default apache error document in mod_perl?" question on SO doesn't help -- the result stays the same.
What should I fix in my Apache configuration, or what should I add to my CGI script to suppress appending error page by mod_perl / Apache to generated response?
The FAQ works for me , after your CGI is done, after headers are sent, tell apache the status is ok, so it doesn't send ErrorDocument
http://search.cpan.org/~gozer/mod_perl-1.31/faq/mod_perl_faq.pod#So_how_do_I_use_mod_perl_in_conjunction_with_ErrorDocument%3F
#!/usr/bin/perl --
use strict; use warnings;
use CGI;
Main( #ARGV );
exit( 0 );
sub Main {
my404();
#~ my $r = CGI::Simple->new->_mod_perl_request;
my $r = CGI->new->r;
$r->status(200);
return;
}
sub my404 {
my $cgi = CGI->new;
print $cgi->header( -status => 404 );
print "<html><title>print404 says tough noogies</title>
<body><h1>tough noogies</h1></body></html>";
}
__END__
GET http://localhost/perl/print404
User-Agent: lwp-request/6.03 libwww-perl/6.03
404 Not Found
Connection: close
Date: Sun, 27 Nov 2011 20:55:39 GMT
Server: Apache/2.0.54 (Win32) mod_ssl/2.0.54 OpenSSL/0.9.7g PHP/4.3.11 mod_perl/2.0.1 Perl/v5.8.9
Content-Type: text/html; charset=ISO-8859-1
Client-Date: Sun, 27 Nov 2011 20:55:39 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
Client-Transfer-Encoding: chunked
Title: print404 says tough noogies
<html><title>print404 says tough noogies</title>
<body><h1>tough noogies</h1></body></html>
My version of the code, but working more stable:
#!/usr/bin/perl
use CGI qw/:standard/ ;
my $Content_of_webpage = 'Oops. 404 error ...' ;
my $status_code = 404 ;
if( $ENV{MOD_PERL} ) { # mod_perl ON
my $r = CGI->new->r ;
$r->status($status_code) ;
$r->content_type("text/html; charset=UTF-8") ;
$r->rflush ; # send the headers out << it is the trick :)
$r->status(200) ;
}
else { # mod_perl OFF
my $cgi = CGI->new ;
print $cgi->header(
-type => "text/html",
-status => $status_code,
-charset => 'UTF-8'
);
}
print $Content_of_webpage ;
I seem to be facing the same problem: I set header status to 400 in case of an error and return JSON array to describe the actual error.
When I do:
print $main::cgi->header(#ret), $html;
With variables:
#ret: {'-type' => 'application/json','-charset' => 'utf-8','-status' => '400 Bad Request'}
$html: '{"errors":{"short_name":["Missing!"]}}'
I will end up with this:
Status Code: 200 OK
Content-Type: application/json; charset=utf-8
Response: {"errors":{"short_name":["Missing!"]}<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>400 Bad Request</title>
</head><body>
<h1>Bad Request</h1>
<p>Your browser sent a request that this server could not understand.<br />
</p>
<hr>
<address>Apache/2.2.3 (CentOS) Server at localhost Port 80</address>
</body></html>
Using the method described by faquer will in deed suppress the error document, but still returns status 200 OK, like Jakub Narębski points out.
BUT! I have found a workaround, where $r is a Apache2::RequestRec, using this:
http://perl.apache.org/docs/2.0/user/coding/coding.html#Forcing_HTTP_Response_Headers_Out
(otherwise you would use $r->send_http_header(), I guess)
print $main::cgi->header(#ret), $html;
my $r = $main::cgi->r;
$r->rflush; # force sending headers (with headers set by CGI)
$r->status(200); # tell Apache that everything was ok, dont send error doc.
HTTP response:
Status Code: 400 Bad Request
Content-Type: application/json; charset=utf-8
Response: {"errors":{"short_name":["Missing!"]}}
Apache config:
PerlModule ModPerl::PerlRun
PerlModule CGI
PerlModule Apache::DBI
PerlRequire /var/www/html/startup.pl
PerlSendHeader On
.htaccess:
<Files *.cgi>
SetHandler perl-script
PerlHandler ModPerl::PerlRun
Options ExecCGI
</Files>