In a running Perl program if I have an Op address (either by B::Concise, Devel::Callsite or via mysterious other ways) is there a simple way to cast that into the right kind of B::OP, short of walking an Opcode tree?
To try to make this clearer, here's some code:
use Devel::Callsite;
use B::Concise qw(set_style);
use B;
sub testing
{
sub foo { callsite() };
my $op_addr = foo;
printf "Op address is 0x%x\n", $op_addr;
# I can get OPs by walking and looking for $op_addr,
# but I don't want to do that.
my $walker = B::Concise::compile('-terse', '-src', \&testing);
B::Concise::walk_output(\my $buf);
$walker->(); # walks and renders into $buf;
print $buf;
}
testing();
When this is run you'll see something like:
$ perl /tmp/foo.pl
Op address is 0x2026940
B::Concise::compile(CODE(0x1f32b18))
UNOP (0x1f40fd0) leavesub [1]
LISTOP (0x20aa870) lineseq
# 8: my $op_addr = foo;
COP (0x1f7cd80) nextstate
BINOP (0x20aba80) sassign
UNOP (0x20ad200) entersub [2]
UNOP (0x1f39b80) null [148]
OP (0x1fd14f0) pushmark
UNOP (0x1f397c0) null [17]
SVOP (0x1f39890) gv GV (0x1fa0968) *foo
OP (0x2026940) padsv [1]
^^^^^^^^^^
....
So 0x2026940 is the address of a B::OP and and which according to this has next(), sibling(), name() methods. If the address were say 0x20aa870 that would be the address of a LISTOP which has in addition a children() method.
I added B::Concise just to show what's going on. In practice I don't want to walk the optree, because I'm assuming/hoping that the address is in fact where that listop resides.
So perhaps there are two parts, first casting an address to B::Op which I believe is the parent class, but after that I'd like to know which kind of Op, (UNOP, BINOP, LISTOP) we are then talking about.
If I can get the cast part done, the second part is probably easy: all B::OP's have a name() method, so from that I can figure out what subclass of OP I have.
EDIT:
ikegami's solution is now part of Devel::Callsite version 1.0.1 al though it isn't quite right.
This duplicates B's internal make_op_object.
use B qw( );
use Inline C => <<'__EOS__';
static const char * const opclassnames[] = {
"B::NULL",
"B::OP",
"B::UNOP",
"B::BINOP",
"B::LOGOP",
"B::LISTOP",
"B::PMOP",
"B::SVOP",
"B::PADOP",
"B::PVOP",
"B::LOOP",
"B::COP",
"B::METHOP",
"B::UNOP_AUX"
};
SV *make_op_object(IV o_addr) {
const OP *o = INT2PTR(OP*, o_addr);
SV *opsv = newSV(0);
sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), o_addr);
return opsv;
}
__EOS__
Example use:
use Devel::Callsite qw( callsite );
my $site = sub { return callsite() };
my $addr = $site->();
my $op = make_op_object($addr);
say $op->name;
Related
What should I do if I have to pass two values for same variable? Does following syntax work ?
sub get_db { return "database_name", "new_database"};
It does not pass both the value
The simplest way to return several values from a sub is a list: (NOTE - none of the following code has been tested)
return ($db_name, $new_db, $table, $rows)
...
my ($database_name, $database, $table_name, $entry_count) = get_db();
but that's easy to mess up - if you have a missmatch between the number of things returned and received something silently becomes undef. Likewise if the order of returned values is wrong, you are going to introduce a subtle bug.
Slightly better is to return a hashref;
....
my $return_values = { NAME => $db_name , DB => $new_db , TABLE => $table } ;
# add the number of rows and return it
$return_values->{ COUNT } = $rows ;
return $return_values ;
...
...
my $db_stuff = get_db();
for my $i (1 .. $db_stuff->{COUNT}) {
...
Better again is to learn a little OO and return an object. Moo is one of many options - it would look something like this:
Package DBstuff;
has name, is => ro ;
has db, is => ro ;
has table, is => ro ;
has count, is => rw ;
1;
... in another file ...
my $db_stuff = DBstuff->new(
name => $name ,
db => $db ,
table => $table,
);
# Add rows and return
$db_stuff->count( $rows );
return $db_stuff ;
...
...
my $db_data = get_db();
for my $i (1 .. $db_data->count) {
...
There is also a module called Object::Result which would almost certainly be overkill but whether you use it or not, I'd like to recommend the RATIONAL section of that module's documentation which covers the issue of returning several things from a sub in more depth.
Perl allows to return an array with multiple values, e.g.
sub get_db { return ["database_name", "new_database"] };
I am using Geo::IP to perform location lookups on ip addresses. Everything works fine until I come across an ip address which is not in the geo ip lookup database and the program shuts abruptly giving this error
Can't call method "city" on an undefined value at script.pl line 16.
Current code looks like this
$gi = Geo::IP->open("/usr/local/share/GeoIP/GeoLiteCity.dat", GEOIP_STANDARD);
my $record = $gi->record_by_addr($key);
my $city= $record->city;
Any suggestions on how I can by pass this? It works perfectly fine until it hits an ip address that isn't defined within that module.
Looking at the Geo::IP source, if the IP address is not in the database, it returns undef. Therefore, to bypass the problem, you can do:
my $record = $gi->record_by_addr($key);
## check that $record is defined
if ($record) {
my $city= $record->city;
...
}
else {
# issue an error message if wanted
warn "No record found for $key";
}
Relevant code from the Geo::IP source:
The function you're using is record_by_addr. From the source, record_by_addr is an alias for get_city_record_as_hash (see perlref for the syntax used to create an 'alias' for a function):
*record_by_addr = \&get_city_record_as_hash;
The code for get_city_record_as_hash is as follows:
#this function returns the city record as a hash ref
sub get_city_record_as_hash {
my ( $gi, $host ) = #_;
my %gir;
#gir{qw/ country_code country_code3 country_name region city
postal_code latitude longitude dma_code area_code
continent_code region_name metro_code / } =
$gi->get_city_record($host);
return defined($gir{latitude}) ? bless( \%gir, 'Geo::IP::Record' ) : undef;
}
This code runs get_city_record using $host, the IP address you supplied, as the argument. If get_city_record finds a record, the data it returns populates the %gir hash. The last line of the sub uses the [ternary form of if-else] to evaluate whether getting the record was successful, and to return the appropriate result. It checks whether $gir{latitude} is defined, and if it is, it creates and returns a Geo::IP::Record object from it (which you can query with methods like city, etc.). If it isn't, it returns undef.
A simpler way to view the last line would be this:
# is $gir{latitude} defined?
if (defined ($gir{latitude})) {
# yes: create a Geo::IP::Record object with the data in %gir
# return that object
return bless( \%gir, 'Geo::IP::Record' )
}
else {
# no: return undefined.
return undef;
}
I'd suggest that you need Data::Dumper here, to tell you what's going on with $record. I would guess that record_by_addr($key); is the root of your problems, and that because $key is in some way bad, $record is undefined.
This would thus be fixed:
use Data::Dumper;
print Dumper \$record;
I'm guessing $record will be undefined, and therefore:
next unless $record;
will skip it.
This is duplicate of my question on SWIG mailing list.
I am trying to use stl containers in my SWIG bindings. Everything works perfectly except for stl map handling in Perl. On C++ side, I have
std::map<std::string, std::string> TryMap(const std::map<std::string, std::string> &map) {
std::map<std::string, std::string> modified(map);
modified["7"] = "!";
return modified;
}
SWIG config look like this
%module stl
%include "std_string.i"
%include "std_map.i"
%template(StringStringMap) std::map<std::string, std::string>;
%{
#include "stl.h"
%}
%include "stl.h"
In my Python script I can call TryMap this way
print dict(stl.TryMap({'a': '4'}))
and get beautiful output
{'a': '4', '7': '!'}
but in Perl I call
print Dumper stl::TryMap({'a' => '4'});
and get an error
TypeError in method 'TryMap', argument 1 of type 'std::map< std::string,std::string > const &' at perl.pl line 7.
I can actually do something like
my $map = stl::TryMap(stl::StringStringMap->new());
print $map->get('7');
and get '!', but this is not an option because there is a lot of legacy code using "TryMap" that expects normal Perl hash as its output.
I believe there is a way work this out because SWIG solves this particular problem nicely in Python and even in Perl if I use stl vectors and strings but not maps.
Is there any way to handle stl map with Perl in SWIG? I am using latest SWIG 2.0.7
UPDATE Maybe there is something wrong with perl5/std_map.i. It is too short =)
$ wc -l perl5/std_map.i python/std_map.i
74 perl5/std_map.i
305 python/std_map.i
I put your C++ function into header file as an inline function for testing.
I was then able to construct a SWIG interface that does what you are looking for. It has two key parts. Firstly I wrote a typemap that will allow either a std::map, or a perl hash to be given as input to C++ functions that expect a std::map. In the case of the latter it builds a temporary map from the perl hash to use as the argument. (Which is convenient but potentially slow). The typemap picks the correct behaviour by checking what it was actually passed in.
The second part of the solution is to map some of the C++ map's member functions onto the special functions that perl uses for overloading operations on hashes. Most of these are implemented simply with %rename where the C++ function and perl functions are compatible however FIRSTKEY and NEXTKEY don't map well onto C++'s iterators, so these were implemented using %extend and (internally) another std::map to store the iteration state of the maps we're wrapping.
There are no special typemaps implemented here for returning the maps, however there is extra behaviour via the special operations that are now implemented.
The SWIG interface looks like:
%module stl
%include <std_string.i>
%include <exception.i>
%rename(FETCH) std::map<std::string, std::string>::get;
%rename(STORE) std::map<std::string, std::string>::set;
%rename(EXISTS) std::map<std::string, std::string>::has_key;
%rename(DELETE) std::map<std::string, std::string>::del;
%rename(SCALAR) std::map<std::string, std::string>::size;
%rename(CLEAR) std::map<std::string, std::string>::clear;
%{
#include <map>
#include <string>
// For iteration support, will leak if iteration stops before the end ever.
static std::map<void*, std::map<std::string, std::string>::const_iterator> iterstate;
const char *current(std::map<std::string, std::string>& map) {
std::map<void*, std::map<std::string, std::string>::const_iterator>::iterator it = iterstate.find(&map);
if (it != iterstate.end() && map.end() == it->second) {
// clean up entry in the global map
iterstate.erase(it);
it = iterstate.end();
}
if (it == iterstate.end())
return NULL;
else
return it->second->first.c_str();
}
%}
%extend std::map<std::string, std::string> {
std::map<std::string, std::string> *TIEHASH() {
return $self;
}
const char *FIRSTKEY() {
iterstate[$self] = $self->begin();
return current(*$self);
}
const char *NEXTKEY(const std::string&) {
++iterstate[$self];
return current(*$self);
}
}
%include <std_map.i>
%typemap(in,noblock=1) const std::map<std::string, std::string>& (void *argp=0, int res=0, $1_ltype tempmap=0) {
res = SWIG_ConvertPtr($input, &argp, $descriptor, %convertptr_flags);
if (!SWIG_IsOK(res)) {
if (SvROK($input) && SvTYPE(SvRV($input)) == SVt_PVHV) {
fprintf(stderr, "Convert HV to map\n");
tempmap = new $1_basetype;
HV *hv = (HV*)SvRV($input);
HE *hentry;
hv_iterinit(hv);
while ((hentry = hv_iternext(hv))) {
std::string *val=0;
// TODO: handle errors here
SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2(HeVAL(hentry), &val);
fprintf(stderr, "%s => %s\n", HeKEY(hentry), val->c_str());
(*tempmap)[HeKEY(hentry)] = *val;
delete val;
}
argp = tempmap;
}
else {
%argument_fail(res, "$type", $symname, $argnum);
}
}
if (!argp) { %argument_nullref("$type", $symname, $argnum); }
$1 = %reinterpret_cast(argp, $ltype);
}
%typemap(freearg,noblock=1) const std::map<std::string, std::string>& {
delete tempmap$argnum;
}
%template(StringStringMap) std::map<std::string, std::string>;
%{
#include "stl.h"
%}
%include "stl.h"
I then adapted your sample perl to test:
use Data::Dumper;
use stl;
my $v = stl::TryMap(stl::StringStringMap->new());
$v->{'a'} = '1';
print Dumper $v;
print Dumper stl::TryMap({'a' => '4'});
print Dumper stl::TryMap($v);
foreach my $key (keys %{$v}) {
print "$key => $v->{$key}\n";
}
print $v->{'7'}."\n";
Which I was able to run successfully:
Got map: 0x22bfb80
$VAR1 = bless( {
'7' => '!',
'a' => '1'
}, 'stl::StringStringMap' );
Convert HV to map
a => 4
Got map: 0x22af710
In C++ map: a => 4
$VAR1 = bless( {
'7' => '!',
'a' => '4'
}, 'stl::StringStringMap' );
Got map: 0x22bfb20
In C++ map: 7 => !
In C++ map: a => 1
$VAR1 = bless( {
'7' => '!',
'a' => '1'
}, 'stl::StringStringMap' );
7 => !
a => 1
!
You can also tie this object to a hash, for example:
use stl;
my $v = stl::TryMap(stl::StringStringMap->new());
print "$v\n";
tie %foo, "stl::StringStringMap", $v;
print $foo{'a'}."\n";
print tied(%foo)."\n";
In theory you can write an out typemap to set up this tie automatically on return from every function call, but so far I've not succeeded in writing a typemap that works with both the tying and the SWIG runtime type system.
It should be noted that this isn't production ready code. There's a thread safety issue for the internal map and some error handling missing too that I know of. I've also not fully tested all of hash operations work from the perl side beyond what you see above. It would also be nice to make it more generic, by interacting with the swig_map_common macro. Finally I'm not a perl guru by any means and I've not used the C API much so some caution in that area would be in order.
This is a sub routine that I copied from CPAN. It works fine as it is when I run it from the command line. I have a similar function from Net::Traceroute that also works fine AND allows me to return the string with a SOAP call. The problem comes when I try to return the ~string(?) from the function below with a SOAP call.
sub tr {
use Net::Traceroute::PurePerl;
my $t = new Net::Traceroute::PurePerl(
backend => 'PurePerl', # this optional
host => 'www.whatever.com',
debug => 0,
max_ttl => 30,
query_timeout => 2,
packetlen => 40,
protocol => 'udp', # Or icmp
);
$t->traceroute;
return $t;
}
The output looks like a string except the last part of the string looks like this:
28 * * *
29 * * *
30 * * *
Net::Traceroute::PurePerl=HASH(0x11fa6bf0)
I don't know what is different about Net::Traceroute::PurePerl that won't allow me to return the value with SOAP since the Net::Traceroute version does allow me to return it with SOAP.
Edit:
To debug, I just edited the last lines like this:
#$t->traceroute;
#return $t;
$foo = "test";
return $foo;
Note that this returns "test" throught the SOAP call. However, if I uncomment $t->traceroute;, the SOAP call breaks. The client side gets nothing back through the SOAP call.
Anytime you see something that looks like "HASH(0x11fa6bf0)", try using Data::Dumper to show you what it is.
(Assuming your hashref is in $t)
use Data::Dumper;
print Dumper $t;
(Data::Printer will give you an even more useful look at what's inside your reference, particularly if you've got coderefs inside it, but the advantage of Data::Dumper is that it's been in the Perl core for a long time, so you should always have it available...)
Add $t->pretty_print; after $t->traceroute;
I've been a proponent of adopting Moose (and MooseX::Declare) at work for several months. The style it encourages will really help the maintainability of our codebase, but not without some initial cost of learning new syntax, and especially in learning how to parse type validation errors.
I've seen discussion online of this problem, and thought I'd post a query to this community for:
a) known solutions
b) discussion of what validation error messages should look like
c) propose a proof of concept that implements some ideas
I'll also contact the authors, but I've seen some good discussion this forum too, so I thought I'd post something public.
#!/usr/bin/perl
use MooseX::Declare;
class Foo {
has 'x' => (isa => 'Int', is => 'ro');
method doit( Int $id, Str :$z, Str :$y ) {
print "doit called with id = " . $id . "\n";
print "z = " . $z . "\n";
print "y = " . $y . "\n";
}
method bar( ) {
$self->doit(); # 2, z => 'hello', y => 'there' );
}
}
my $foo = Foo->new( x => 4 );
$foo->bar();
Note the mismatch in the call to Foo::doit with the method's signature.
The error message that results is:
Validation failed for 'MooseX::Types::Structured::Tuple[MooseX::Types::Structured::Tuple[Object,Int],MooseX::Types::Structured::Dict[z,MooseX::Types::Structured::Optional[Str],y,MooseX::Types::Structured::Optional[Str]]]' failed with value [ [ Foo=HASH(0x2e02dd0) ], { } ], Internal Validation Error is: Validation failed for 'MooseX::Types::Structured::Tuple[Object,Int]' failed with value [ Foo{ x: 4 } ] at /usr/local/share/perl/5.10.0/MooseX/Method/Signatures/Meta/Method.pm line 441
MooseX::Method::Signatures::Meta::Method::validate('MooseX::Method::Signatures::Meta::Method=HASH(0x2ed9dd0)', 'ARRAY(0x2eb8b28)') called at /usr/local/share/perl/5.10.0/MooseX/Method/Signatures/Meta/Method.pm line 145
Foo::doit('Foo=HASH(0x2e02dd0)') called at ./type_mismatch.pl line 15
Foo::bar('Foo=HASH(0x2e02dd0)') called at ./type_mismatch.pl line 20
I think that most agree that this is not as direct as it could be. I've implemented a hack in my local copy of MooseX::Method::Signatures::Meta::Method that yields this output for the same program:
Validation failed for
'[[Object,Int],Dict[z,Optional[Str],y,Optional[Str]]]' failed with value [ [ Foo=HASH(0x1c97d48) ], { } ]
Internal Validation Error:
'[Object,Int]' failed with value [ Foo{ x: 4 } ]
Caller: ./type_mismatch.pl line 15 (package Foo, subroutine Foo::doit)
The super-hacky code that does this is
if (defined (my $msg = $self->type_constraint->validate($args, \$coerced))) {
if( $msg =~ /MooseX::Types::Structured::/ ) {
$msg =~ s/MooseX::Types::Structured:://g;
$msg =~ s/,.Internal/\n\nInternal/;
$msg =~ s/failed.for./failed for\n\n /g;
$msg =~ s/Tuple//g;
$msg =~ s/ is: Validation failed for/:/;
}
my ($pkg, $filename, $lineno, $subroutine) = caller(1);
$msg .= "\n\nCaller: $filename line $lineno (package $pkg, subroutine $subroutine)\n";
die $msg;
}
[Note: With a few more minutes of crawling the code, it looks like MooseX::Meta::TypeConstraint::Structured::validate is a little closer to the code that should be changed. In any case, the question about the ideal error message, and whether anyone is actively working on or thinking about similar changes stands.]
Which accomplishes 3 things:
1) Less verbose, more whitespace (I debated including s/Tuple//, but am sticking with it for now)
2) Including calling file/line (with brittle use of caller(1))
3) die instead of confess -- since as I see it the main advantage of confess was finding the user's entry point into the typechecking anyway, which we can achieve in less verbose ways
Of course I don't actually want to support this patch. My question is: What is the best way of balancing completeness and succinctness of these error messages, and are there any current plans to put something like this in place?
I'm glad you like MooseX::Declare. However, the method signature validation
errors you're talking about aren't really from there, but from
MooseX::Method::Signatures, which in turn uses MooseX::Types::Structured for
its validation needs. Every validation error you currently see comes unmodified
from MooseX::Types::Structured.
I'm also going to ignore the stack-trace part of the error message. I happen to
find them incredibly useful, and so does the rest of Moose cabal. I'm not going
to removed them by default.
If you want a way to turn them off, Moose needs to be changed to throw exception
objects instead of strings for type-constraint validation errors and possibly
other things. Those could always capture a backtrace, but the decision on
whether or not to display it, or how exactly to format it when displaying, could
be made elsewhere, and the user would be free to modify the default behaviour -
globally, locally, lexically, whatever.
What I'm going to address is building the actual validation error messages for
method signatures.
As pointed out, MooseX::Types::Structured does the actual validation
work. When something fails to validate, it's its job to raise an exception. This
exception currently happens to be a string, so it's not all that useful when
wanting to build beautiful errors, so that needs to change, similar to the issue
with stack traces above.
Once MooseX::Types::Structured throws structured exception objects, which might
look somewhat like
bless({
type => Tuple[Tuple[Object,Int],Dict[z,Optional[Str],y,Optional[Str]]],
err => [
0 => bless({
type => Tuple[Object,Int],
err => [
0 => undef,
1 => bless({
type => Int,
err => bless({}, 'ValidationError::MissingValue'),
}, 'ValidationError'),
],
}, 'ValidationError::Tuple'),
1 => undef,
],
}, 'ValidationError::Tuple')
we would have enough information available to actually correlate individual
inner validation errors with parts of the signature in MooseX::Method::Signatures. In the above example, and
given your (Int $id, Str :$z, Str :$y) signature, it'd be easy enough to know
that the very inner Validation::MissingValue for the second element of the
tuple for positional parameters was supposed to provide a value for $id, but
couldn't.
Given that, it'll be easy to generate errors such as
http://files.perldition.org/err1.png
or
http://files.perldition.org/err2.png
which is kind of what I'm going for, instead of just formatting the horrible
messages we have right now more nicely. However, if one wanted to do that, it'd
still be easy enough once we have structured validation exceptions instead of
plain strings.
None of this is actually hard - it just needs doing. If anyone feels like helping
out with this, come talk to us in #moose on irc.perl.org.
Method::Signatures::Modifiers is a package which hopes to fix some of the problems of MooseX::Method::Signatures. Simply use it to overload.
use MooseX::Declare;
use Method::Signatures::Modifiers;
class Foo
{
method bar (Int $thing) {
# this method is declared with Method::Signatures instead of MooseX::Method::Signatures
}
}