Can $self be passed to a XML::Twig handler? - perl

I'm trying to parse different XML that is returned depending on the command given in a class method... but I think I'm getting a bit deep here.
I'd like to be able to use other methods and access attributes of the instance from WITHIN the XML::Twig handler.
This is an instance method I defined in a Moose object in order to get and parse XML using XML::Twig:
sub get_xmls {
my $self = shift;
my $sehost = shift;
my $symm = shift;
$self->log->info("Getting XMLs for $sehost - $symm");
my %SYMMAPI_CALLS = (
"Config" => {
'command' => "symcfg list -sid ${symm} -v",
'handlers' => {
'SymCLI_ML/Symmetrix' => $self->can('process_symm_info')
},
'dbtable' => "inv_emc_array"
},
"Pools" => {
'command' => "symcfg -sid ${symm} list -pool -thin",
'handlers' => {
'DevicePool' => $self->can('process_symm_pool')
},
'dbtable' => "inv_emc_pool"
}
);
foreach my $key (sort(keys %SYMMAPI_CALLS)) {
my $xmldir = $self->xmlDir;
my $table = $SYMMAPI_CALLS{$key}{'tbl'};
my $handlers = $SYMMAPI_CALLS{$key}{'handlers'};
my $command = $SYMMAPI_CALLS{$key}{'command'};
my $xmlfile = qq(${xmldir}/${sehost}/${key}_${symm}.xml);
$self->log->info("\t$key");
if(!-d qq(${xmldir}/${sehost})) {
mkdir(qq(${xmldir}/${sehost}))
or $self->log->logdie("Cant make dir ${xmldir}/${sehost}: $!");
}
$self->_save_symxml($command, $xmlfile);
$self->twig(new XML::Twig( twig_handlers => $handlers ));
$self->log->info("Parsing $xmlfile...");
$self->twig->parsefile($xmlfile);
$self->log->info("\t\t...finished.");
die "Only running the first config case for now...";
}
}
And the definition of one of the handlers (not really doing anything right now while I figure out how to do this correctly:
sub process_symm_info {
my ($twig, $symminfo) = #_;
print Dumper($symminfo);
}
This works just fine, but what I'd like is for the process_symm_info method to have access to $self and all the methods and attributes $self brings along with it. Is that possible? Am I doing this all wrong? Since I can specify specific parts of the XML it'd be nice to be able to do other things with that data from within the handler.
This is sort of my first venture into Perl Moose (if you couldn't already tell).

Currently, you have
handlers => {
DevicePool => $self->can('process_symm_pool'),
},
Change it to
handlers => {
DevicePool => sub { $self->process_symm_pool(#_) },
},
The variable $self will be captured by the anonymous sub. This is why the following works:
sub make {
my ($s) = #_;
return sub { return $s };
}
my $x = make("Hello, ");
my $y = make("World!\n");
print $x->(), $y->(); # Hello, World!
The world of closures, that is :)

Related

Implementing a dispatch table

I'm trying to implement a dispatch table which calls functions inside a Perl module. I know how to implement dispatch tables generally, but I can't seem to get it right when referencing an object method from within $self. Maybe I haven't Googled enough, but so far, the right syntax is elusive.
I have traced the parameters though the calls, and I know what is happening -- the function references are not receiving a reference to $self as their first parameter. This is what I currently have inside $self. I believe I copied this over properly; if I made a mistake and it doesn't run, I apologize.
package MyRefHashTest;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
DISPATCH => {
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour
}
};
bless $self, $class;
return $self;
}
sub funcOne {
my ($self, $param) = #_;
print "func1 $param \n";
}
sub funcTwo {
my ($self, $param) = #_;
print "func2 $param \n";
}
sub funcThree {
my ($self, $param) = #_;
print "func3 $param \n";
}
sub funcFour {
my ($self, $param) = #_;
print "func4 $param \n";
}
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->("string");
}
1;
# To Test:
$test = MyRefHashTest->new;
$test->runTesting("ONE");
$test->runTesting("TWO");
$test->runTesting("THREE");
$test->runTesting("FOUR");
The actual output I get is that $param is undefined in the function calls from the dispatch table, when it should not be. This is how I know that the references to $self are not where they should be. The functions think that $type is $self.
I have tried editing the hash table references so they look like \$self->functionName, but that only results in a compilation error for $self not being properly defined on that line.
Can anyone guide me to the right syntax for this, please?
Thanks!
EDIT: After much more work, I finally found a solution. It's some very interesting syntax, a lot more complicated than I thought. Essentially, I'm building the hash from the inside out:
my $self = {
DISPATCH => undef
};
$self->{DISPATCH} = {
ONE => sub { $self->funcOne(#_); },
TWO => sub { $self->funcTwo(#_); },
THREE => sub { $self->funcThree(#_); },
FOUR => sub { $self->funcFour(#_); }
};
It works, but it seems like a lot of hassle for what it is. If anyone knows of an easier way to do this, I would still be very interested in it. If there isn't an easier way, on the other hand, I hope this can help somebody.
What follows are four approaches for implementing a method-based dispatch table. The differences explained afterwards.
my %DISPATCH = (
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour,
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => __PACKAGE__->can('funcOne'),
TWO => __PACKAGE__->can('funcTwo'),
THREE => __PACKAGE__->can('funcThree'),
FOUR => __PACKAGE__->can('funcFour'),
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => 'funcOne',
TWO => 'funcTwo',
THREE => 'funcThree',
FOUR => 'funcFour',
);
sub runTesting {
my ($self, $type) = #_;
my $method_name = $DISPATCH{$type};
return $self->$method_name("string");
}
or
my %DISPATCH = (
ONE => sub { shift->funcOne(#_) },
TWO => sub { shift->funcTwo(#_) },
THREE => sub { shift->funcThree(#_) },
FOUR => sub { shift->funcFour(#_) },
);
sub runTesting {
my ($self, $type) = #_;
my $cb = $DISPATCH{$type};
return $cb->($self, "string");
}
All four approaches allow the methods to be defined in the same class.
The last three approaches allow the methods to be defined in a superclass as well.
The last two approaches allow a subclass to provide or override the method as well. These are your best options.
How about passing in $self in the dynamic dispatch method:
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->($self,"string");
^^^^^
}
I believe the problem is that you are invoking the methods as plain functions and not object methods.

Pass value from one router to another using Mojolicious::Lite

from an ajax form this router foundname gets called, I need to process the value and pass it to another router, I can't figured it out how to do it, here is a sample of how I am trying:
#!/usr/bin/perl
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
# Here I get the value from the form
my $name_on = $c->req->query_params->param('name');
if($name_on) {
# call another router and pass the name value to it
# It gives an error "Can't locate object method "get" ", I might not need to use "get", just don't know how to pass the value.
$c->get('/process_name')->to( searched => $name_on);
}
};
get '/process_name' => sub {
my $c = shift;
my $got_name = $c->req->query_params->param('searched');
...
};
Thank you!
You need to look up the routes through your Mojolicious::Routes object inside of your app. The name for the lookup is auto-generated by Mojolicious::Lite from the path-part of the URI, so /process_name has the name process_name.
You get back a Mojolicious::Routes::Route, which has a render method and you can pass your parameters along there.
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $process_name = app->routes->lookup('process_name')->render( { searched => $name_on } );
$c->render( text => $process_name );
}
};
get '/process_name' => sub {
my $c = shift;
my $got_name = $c->req->query_params->param('searched');
$c->render( text => $got_name );
};
app->start;
When you curl this you get the parameter back as a response.
$ curl localhost:3000/foundname?name=foo
/process_name
However, this is probably not the right approach. If you want to implement business logic, you should not use internal or hidden routes for that. Remember that your application is still just Perl. You can write a sub and call that.
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $got_name = process_name( $name_on );
$c->render( text => $got_name );
}
};
sub process_name {
my ( $got_name ) = #_;
# do stuff with $got_name
return uc $got_name;
};
app->start;
This will output
$ curl localhost:3000/foundname?name=foo
FOO
It's the more portable approach, as you can easily unit-test these functions. If you want to have $c, you have to pass it along. You also have the app keyword available in any sub you define.
For the original question, I would use
$c->redirect_to()
See this question for details on passing the variable over:
Passing arguments to redirect_to in mojolicious and using them in the target controller
======
But, I would look more into writing subs (as others have said).
If you have existing logic then you can wrap it in a helper or just toss the logic in a helper and call that.
helper('process_name'=> sub{
my $self,$args = #_;
# Do some logic with $args->{'name'}
return $something;
});
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $process_name = $c->process_name({name => $name_on});
$c->render( text => $process_name );
}else{
$c->redner(text => 'Error',status=>500);
}
};

Mojolicious - two non-blocking GET requests in the same controller

I'm writing a Mojolicious module/controller that needs to make two GET requests; one after the other. The second GET request depends on response data from the first.
I would like both requests to be non-blocking. However I can't easily "return" from the context of the first non-blocking callback to supply values to the second request.
sub my_controller {
my ($self) = #_;
$self->ua->get($first_endpoint, sub {
# handle response - extract value for second request?
});
my $second_endpoint = 'parameter not available here';
$self->ua->get($second_endpoint, sub {});
}
I would prefer not to nest the second request into the first callback if possible?
First need to call render_later method in controller because you write non-blocking code.
Exist 2 ways how to pass data:
1)
sub action_in_controller {
my $c = shift->render_later;
$c->delay(
sub {
my $delay = shift;
$c->ua->get('http://one.com' => $delay->begin);
},
sub {
my ($delay, $tx) = #_;
$c->ua->post('http://second.com' => $delay->begin);
},
sub {
my ($delay, $tx) = #_;
$c->render(text => 'la-la-la');
}
);
}
2)
sub action_in_controller {
my $c = shift->render_later;
$c->ua->get('http://one.com' => sub {
my ($ua, $tx) = #_;
$c->ua->post('http://second.com' => sub {
my ($ua, $tx) = #_;
$c->render(text => 'la-la-la');
});
});
}
UPD
Found another variant of calling using Coro.
But in perl 5.22 it not work and need to apply patch to repair it.
You need additionally to write plugin Coro.
Here example. You need only ua.pl and plugin Mojolicious::Plugin::Core.

Perl array attribute inside an object

Tried to write a perl module with OOP, but it can add an object to an array, when I use Dump method, it will output wrong data like this. Where is my error ?
Thanks
bless( {
'_name' => 'CUSIP',
'_validation_array' => [],
'_seq' => '1'
}, 'Field' );
source code:
package Field;
sub new {
my $class = shift;
my $self = {
_name => shift,
_seq => shift,
_validation_array => [ #_ ],
};
bless($self, $class);
return $self;
};
sub pushValidation(){
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
sub dump(){
foreach my $validation (#{$self->{_validation_array} }) {
#print Dumper($validation);#will work,
print $validation->{name}; #error, Use of uninitialized value
}
}
1;
This is the way I call this method :
my $validationObj = new Validation($validation->{name}, $validation->{seq});
$field->pushValidation($validationObj);
I see several problems here, but the most serious one is here:
sub pushValidation() {
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
This function is expecting a $self argument, but isn't shifting it from the arguments. You need to add use strict; at the top of your Perl file. If it had been enabled, the issue would have been immediately obvious:
Global symbol "$self" requires explicit package name at <filename> line <line>.
Same thing goes for the dump() function. (By the way, dump is a bad method name, as there is an (obscure) Perl builtin function with the same name. But that's not a huge issue.)

Is it possible to overwrite the response data in a Mojo::Message::Response?

In a Mojolicious app I have a route in my Controller code like the following:
/account/:id/users
The /account/:id part of the route has the following data in it when I get to the
users part of the chain:
$VAR1 = {
'signup_ip' => '172.17.5.146',
'z_id' => '382C58D8-529E-11E1-BDFB-A44585CCC763',
'signup_date' => '2012-03-12T12:11:10Z',
'name' => 'Some Cool Account Name',
'users' => [
{
'user_id' => '382C67EC-529E-11E1-BDFB-A44585CCC763'
}
],
'account_id' => '382C67EC-529E-11E1-BDFB-A44585CCC763',
};
In the users part of the chain I'm getting the above hash using
$self->tx->res->content->get_body_chunk(0)
sub users {
my $self = shift;
my $user_list = from_json( $self->tx->res->content->get_body_chunk(0) );
$self->respond_to( json => $user_list->{users} );
}
The problem I'm having is that I want to overwrite the response with only
the users arrayref. The code above in sub users(){} doesn't do that. That is,
when I dump the result in the test, I still getting the entire hash.
The $user_list is the arrayref I'm looking for in users() but I'm unable to overwrite it.
Anyone have an idea how to do that?
Hrm I think I put my previous answer in the wrong place. So here it is:
In the application I added the following routes:
my $base = $r->bridge('/account/:id')->to('account#read');
$base->route('/')->via('get')->to('account#index');
$base->route('/users')->via('get')->to('account#users');
In Acount.pm
sub read {
my $self = shift;
# do stuff
$self->stash->{account} = $data; # set the stash
return 1; #return 1. Don't render.
}
sub index {
my $self = shift;
my $data = $self->stash('account'); #get the stash
$self->render_json( $data );
}
sub users {
my $self = shift;
# do stuff
my $data = $self->stash('account');
$self->render_json( $data );
}
Doing this sets the result of /account/:id into the stash in the read sub.
Setting a route to $base->route('/')->via('get')->to('account#index');
causes calls to /account/:id to be rendered from the index sub.
The route $base->route('/users')->via('get')->to('account#users') causes
the calls to /account/:id/users to be rendered from the users sub.
I think you have to provide different parameters to respond_to method. I would expect this to work:
$self->respond_to(json => { json => $user_list->{users} });
Or just call render_json:
$self->render_json($user_list->{users});
Edit: I made simple testing script that works for me (using latter option above):
use Mojolicious::Lite;
get '/account/users' => sub {
my $self = shift;
my $user_list = {
'signup_ip' => '172.17.5.146',
'z_id' => '382C58D8-529E-11E1-BDFB-A44585CCC763',
'signup_date' => '2012-03-12T12:11:10Z',
'name' => 'Some Cool Account Name',
'users' => [{'user_id' => '382C67EC-529E-11E1-BDFB-A44585CCC763'}],
'account_id' => '382C67EC-529E-11E1-BDFB-A44585CCC763',
};
$self->render_json($user_list->{users});
};
app->start;
the request to http://localhost:3000/account/users returned this:
[{"user_id":"382C67EC-529E-11E1-BDFB-A44585CCC763"}]