In Javascript, I am sending a blob using XHR by the following code:
var v=new FormData();
v.append("EFD",new Blob([...Uint8Array...]));
var h=new XMLHttpRequest();
h.setRequestHeader("Content-type","multipart/form-data; charset=utf-8");
h.open("POST","...url...");
h.send(v);
In the server, I have created in Perl the following function, that suppose to implement CGI->param and CGI->upload:
# QS (Query String) receive in argument string for single parameter or array of many required parameters.
# If string been supplied: Return the value of the parameter or undef if missing.
# If array been supplied, a hash will be returned with keys for param names and their corresponding values.
# If the first argument is undef, then return hash with ALL available parameters.
sub QS {
my $b=$ENV{'QUERY_STRING'};
if($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$b,$ENV{'CONTENT_LENGTH'}) or die "E100";
}
my $e=$_[0]; my $t=&AT($e); my $r={}; my #q=split(/&/,$b);
my %p=(); if($t eq "A") { %p=map { $_=>1 } #{$e}; }
foreach my $i(#q) {
my ($k,$s)=split(/=/,$i); $s=~tr/+//; $s=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if($t eq "") { $r->{$k}=$s; }
elsif($t eq "A") { if($p{$k}) { $r->{$k}=$s; } }
elsif($k eq $_[0]) { return $s; }
}
return $r;
}
# AT is a function for determining type of an object, and also a quck way to distinguish between just a string and a number.
sub AT {
if(!defined $_[0]) { return ""; } my $v=ref($_[0]);
if($v eq "") { return ($_[0]*1 eq $_[0])?"N":"S"; }
my $k={"ARRAY"=>"A","HASH"=>"H"};
return $k->{$v}||$_[0]->{_obt}||$v;
}
So in the main program it will be called as:
my $EFD=&FW::QS("EFD"); # FW = The module name where QS and AT are.
When I issuing the POST from the client, the script in the server does not pop-up any errors, and does not terminates - it continues to run and run and run.... Endlessly.... Consuming 100% CPU time and 100% memory - without any explanation.
I have these in the beginning of the script, though:
use strict;
use warnings;
use diagnostics;
but it still behave in such a way that I need to kill the script in order to terminate it...
Anyone know what I did wrong...? No infinite loop here, as far as I know... If I change the Blob to regular classic way of "...url...?EFD=dhglkhserkhgoi" then it works just fine, but I want a Blob....
Thanks a lot
This QS function is only usable for POSTs with an application/x-www-urlencoded body, which yours isn't.
Related
Mojo seems to want add headers to the response. Is there any method to suppress headers given a context object?
$r->get('/')->to( cb => sub {
my $c = shift;
# No headers for this response
} );
In my case, I was using Mojo::Server::CGI. You can see the problems on line 29 and on line 35
return undef if $self->nph && !_write($res, 'get_start_line_chunk');
...
return undef unless _write($res, 'get_header_chunk');
You can get around this by mucking with the internals,
$c->res->content->_headers->{header_buffer} = '';
$c->res->{start_buffer} = '';
But an even better way to is detect if anything has been written to STDOUT and to suppress the whole request if so,
# We withhold headers if anything has written to
# STDOUT. This is neccessary because some scripts, in-transition
# to Mojo will still use `print`, and output headers
if ( tell(*STDOUT) != 0 ) {
return undef;
}
That what I did anyway when I published Mojo::Server::CGI::LegacyMigrate
How to check condition if some custom field empty?
For example, it's possible to check that qa_contact is not set.
sub object_end_of_set_all {
my ($self, $args) = #_;
my $object = $args->{'object'};
if ($object->{'bug_status'} eq 'RESOLVED') {
if ($object->{'qa_contact'} eq "") {
ThrowUserError("empty_qa_contact");
}
}
}
Is there is same way for custom field e.g. cf_test ?
I know that to save custom field in variable, need to:
my $test = new Bugzilla::Field({ name => 'cf_test' });
Which method can be used to get its value or check if it's not empty ?
Found out two problems:
1. After executing ThrowUserError("...") any object (cf_test or even bugzilla fields) is always NULL.
2. If to use Hook "object_end_of_set_all" for custom field then only a cached values are showed for a custom field.
The answer is to use different Hook:
sub bug_end_of_update {
my ($self, $args) = #_;
my ($bug, $old_bug, $timestamp, $changes) = #$args{qw(bug old_bug timestamp changes)};
if ($bug->bug_status eq 'RESOLVED') {
if ($bug->cf_test eq "") {
ThrowUserError("test_is_empty");
}
}
}
failing to properly populate a HoH using this code:
when i run the loop using below:
while (my $form = $form_rs->next ()){
my $menu=$form->get_column("fmenu");
my $script=$form->get_column("fscript");
my $name=$form->get_column("ftitle");
$itemList->{$menu} = {
$script => $name
};
}
print Dumper $itemList;
it runs correctly but since $menu is repeating it only keeps last value in the HoH. So i get erroneous output in Data Dumper. I get only 1 record for each 'menu', whereas there should be many.
getting:
itemList=>{
menu1=>{
script1=>formName1
},
menu2=>{
script3=>formName3
}
...(and so on)
}
whereas EXPECTED:
itemList=>{
menu1=>{
script1=>formName1,
script2=>formName2
},
menu2=>{
script3=>formName3,
...(and so on)
}
...(and so on)
}
pl help.
thank you.
Then you want to update $itemList->{$menu}{$script} rather than assign a reference to a one-element hash to $itemList->{$menu}.
$itemList->{$menu}{$script} = $name;
Right now, I have the following Perl code
my $tmpl1="download1_video.html"
if $file->{file_name}=~/\.(avi|divx|mkv|flv|mp4|wmv)$/i;
$tmpl1||="download1.html";
so it's checking to see if the file is a video, and if so it directs it to the certain page. Although I'm just wondering how I can add another if statement in there to check if the extension is .mp3, and if so direct it to download1_audio.html.
if ( $file->{file_name} =~ m/\.(avi|divx|mkv|flv|mp4|wmv)$/i ){
## Download video
}
elsif($file->{file_name} =~ m/\.(mp3)$/i){
## Download Audio
}
Is this what you needed ?
if ($file->{file_name} =~ /\.(avi|divx|mkv|flv|mp4|mp3|wmv)$/i )
{
if ($1 eq "mp3")
{
# mp3 stuff
}
elsif ($1 eq "mp4")
{
# mp4 stuff
}
else
{
# all other file types
}
}
else
{
# It didn't match
}
A fancier way would be to create a hash keyed by your file types in advance with the info you needed for your next page; the filename I guess?
my %pageHash = ( "mp3" => "mp3Page.html", "divx" => "divxPage.html", ... );
...
$file->{file_name} =~ /\.(.*)$/i;
if (exists $pageHash{$1})
{
$page = $pageHash{$1};
}
else
{
# unknown file extension
}
Having just been burnt by this, I must advise you against declaring a variable with a conditional modifier. If the condition does not hold true, it runs no part of the other clause, which means that you are not declaring $tmpl1, but since it's already passed strict, it allows you to assign to an undefined position in memory.
There is a safer way to do what your predecessor is doing here, that can yet illustrate a solution.
my $tmpl1
= $file->{file_name} =~ /\.(avi|divx|mkv|flv|mp4|wmv)$/i
? 'download1_video.html'
: $file->{file_name} =~ m/\.mp3$/i
? 'download1_audio.html'
: 'download1.html'
;
Thus,
$tmpl1 is always declared
$tmpl1 is always assigned a value
I'm a newbie in Perl.
I have a JSON-RPC server running at http://localhost:19000 and I need to call checkEmail() method.
use JSON::RPC::Client;
my $client = new JSON::RPC::Client;
my $url = 'http://localhost:19000';
my $callobj = {
method => 'checkEmail',
params => [ 'rprikhodchenko#gmail.com' ],
};
my $res = $client->call($url, $callobj);
if($res) {
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
When I try to launch it it tells following:
perl ./check_ac.pl
Not a HASH reference at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 193.
UPD:
Full stack-trace:
perl -MCarp::Always ./check_ac.pl
Not a HASH reference at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 193
JSON::RPC::ReturnObject::new('JSON::RPC::ReturnObject', 'HTTP::Response=HASH(0x9938d48)', 'JSON=SCALAR(0x96f1518)') called at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 118
JSON::RPC::Client::call('JSON::RPC::Client=HASH(0x944a818)', 'http://localhost:19000', 'HASH(0x96f1578)') called at ./check_ac.pl line 11
This error means that your JSON-RPC server is not actually one, inasmuch as it does not satisfy requirement 7.3. The error is triggered when JSON::RPC::Client assumes the document returned by the JSON-RPC service is well-formed (i.e., a JSON Object), and this assumptions turns out to have been in error. A bug report to the author of JSON::RPC::Client would be an appropriate way to request better error messaging.
I would attack this sort of problem by finding out what the server was returning that was causing JSON::RPC::Client to choke. Unfortunately, JRC fails to provide adequate hookpoints for finding this out, so you'll have to be a little bit tricky.
I don't like editing external libraries, so I recommend an extend-and-override approach to instrumenting traffic with the JSON-RPC server. Something like this (in check_ac.pl):
use Data::Dumper qw();
package JSON::RPC::InstrumentedClient;
use base 'JSON::RPC::Client';
# This would be better done with Module::Install, but I'm limiting dependencies today.
sub _get {
my ($self, #args) = #_;
return $self->_dump_response($self->SUPER::_get(#args));
}
sub _post {
my ($self, #args) = #_;
return $self->_dump_response($self->SUPER::_post(#args));
}
sub _dump_response {
my ($self, $response) = #_;
warn Data::Dumper::Dump([$response->decoded_content], [qw(content)]);
return $response;
}
package main;
my $client = JSON::RPC::InstrumentedClient->new();
my $url = 'http://localhost:19000';
... # rest of check_ac.pl
This wraps the calls to _get and _post that JSON::RPC::Client makes internally in such a way as to let you examine what the web server actually said in response to the request we made. The above code dumps the text content of the page; this might not be the right thing in your case and will blow up if an error is encountered. It's a debugging aid only, to help you figure out from the client code side what is wrong with the server.
That's enough caveats for now, I think. Good luck.
It seems to be a bug in method new of JSON::RPC::ReturnObject.
sub new {
my ($class, $obj, $json) = #_;
my $content = ( $json || JSON->new->utf8 )->decode( $obj->content );
#...
# line 193
$content->{error} ? $self->is_success(0) : $self->is_success(1);
#...
}
$content's value will be something returned from a JSON::decode() call. But looking at the documentation, it seems that JSON->decode() returns a scalar which could be a number, a string, an array reference, or a hash reference.
Unfortunately, JSON::RPC::ReturnObject->new() doesn't check what sort of thing JSON->decode() returned before trying to access it as a hashref. Given your error, I'm going to go ahead and assume what it got in your case was not one. :-)
I don't know if there's a way to force a fix from your code. I'd recommend contacting the author and letting him know about the issue, and/or filing a bug.