Attempt to access upserted_id property in perl MongoDB Driver returns useless HASH(0x3572074) - mongodb

I have a Perl script that pulls a table from a SQL database ($row variable) and attempts to do a MongoDB update like so:
my $res = $users->update({"meeting_id" => $row[0]},
{'$set' => {
"meeting_id" => $row[0],
"case_id" => $row[1],
"case_desc" => $row[2],
"date" => $row[3],
"start_time" => $row[4],
"end_time" => $row[5],
#"mediator_LawyerID" => $row[6],
"mediator_LawyerIDs" => \#medLawIds,
"case_number" => $row[6],
"case_name" => $row[7],
"location" => $row[8],
"number_of_parties" => $row[9],
"case_manager" => $row[10],
"last_updated" => $row[11],
"meeting_result" => $row[12],
"parties" => \#partyList
}},
{'upsert' => 1}) or die "I ain't update!!!";
My client now wants ICS style calendar invites sent to their mediators. Thus, I need to know whether an update or insert happened. The documentation for MongoDB::UpdateResult implies that this is how you access such a property:
my $id = $res->upserted_id;
So I tried:
bless ($res,"MongoDB::UpdateResult");
my $id = $res->upserted_id;
After this code $id is like:
HASH(0x356f8fc)
Are these the actual IDs? If so, how do I convert to a hexadecimal string that can be cast to Mongo's ObjectId type? It should be noted I know absolutely nothing about perl; if more of the code is relevant, at request I will post any section ASAP. Its 300 lines so I didn't want to include the whole file off the bat.
EDIT: I should mention before anyone suggests this that using update_one instead of update returns the exact same result.

HASH(0x356f8fc) is a Perl Hash reference. It's basically some kind of (internal) memory address of some data.
The easiest way to get the contents is Data::Dumper:
use Data::Dumper
[...]
my $result = $res->upserted_id;
print Dumper($result);
HASH(0x356f8fc) is just the human readable representation of the real pointer. You must dump it in the same process and can't pass it from one to another.
You'll probably end up with something like
`my $id = $result->{_id};`
See the PerlRef manpage for details.
See also the MongoDB documentation about write concern.
PS: Also remember that you could use your own IDs for MongoDB. You don't need to work with the generated ones.

Related

How to fetch values that are hard coded in a Perl subroutine?

I have a perl code like this:
use constant OPERATING_MODE_MAIN_ADMIN => 'super_admin';
use constant OPERATING_MODE_ADMIN => 'admin';
use constant OPERATING_MODE_USER => 'user';
sub system_details
{
return {
operating_modes => {
values => [OPERATING_MODE_MAIN_ADMIN, OPERATING_MODE_ADMIN, OPERATING_MODE_USER],
help => {
'super_admin' => 'The system displays the settings for super admin',
'admin' => 'The system displays settings for normal admin',
'user' => 'No settings are displayed. Only user level pages.'
}
},
log_level => {
values => [qw(FATAL ERROR WARN INFO DEBUG TRACE)],
help => "http://search.cpan.org/~mschilli/Log-Log4perl-1.49/lib/Log/Log4perl.pm#Log_Levels"
},
};
}
How will I access the "value" fields and "help" fields of each key from another subroutine? Suppose I want the values of operating_mode alone or log_level alone?
The system_details() returns a hashref, which has two keys with values being hashrefs. So you can dereference the sub's return and assign into a hash, and then extract what you need
my %sys = %{ system_details() };
my #loglevel_vals = #{ $sys{log_level}->{values} };
my $help_msg = $sys{log_level}->{help};
The #loglevel_vals array contains FATAL, ERROR etc, while $help_msg has the message string.
This makes an extra copy of a hash while one can work with a reference, as in doimen's answer
my $sys = system_details();
my #loglevel_vals = #{ $sys->{log_level}->{values} };
But as the purpose is to interrogate the data in another sub it also makes sense to work with a local copy, what is generally safer (against accidentally changing data in the caller).
There are modules that help with deciphering complex data structures, by displaying them. This helps devising ways to work with data. Often quoted is Data::Dumper, which also does more than show data. Some of the others are meant to simply display the data. A couple of nice ones are Data::Dump and Data::Printer.
my $sys = system_details;
my $log_level = $sys->{'log_level'};
my #values = #{ $log_level->{'values'} };
my $help = $log_level->{'help'};
If you need to introspect the type of structure stored in help (for example help in operating_mode is a hash, but in log_level it is a string), use the ref builtin func.

Writing simple parser in Perl: having lexer output, where to go next?

I'm trying to write a simple data manipulation language in Perl (read-only, it's meant to transform SQL-inspired queries into filters and properties to use with vSphere Perl API: http://pubs.vmware.com/vsphere-60/topic/com.vmware.perlsdk.pg.doc/viperl_advancedtopics.5.1.html_)
I currently have something similar to lexer output if I understand it properly - a list of tokens like this (Data::Dumper prints array of hashes):
$VAR1 = {
'word' => 'SHOW',
'part' => 'verb',
'position' => 0
};
$VAR2 = {
'part' => 'bareword',
'word' => 'name,',
'position' => 1
};
$VAR3 = {
'word' => 'cpu,',
'part' => 'bareword',
'position' => 2
};
$VAR4 = {
'word' => 'ram',
'part' => 'bareword',
'position' => 3
};
Now what I'd like to do is to build a syntax tree. The documentation I've seen so far is mostly on using modules and generating grammars from BNF, but at the moment I can't wrap my head around it.
I'd like to tinker with relatively simple procedural code, probably recursive, to make some ugly implementation myself.
What I'm currently thinking about is building a string of $token->{'part'}s like this:
my $parts = 'verb bareword bareword ... terminator';
and then running a big and ugly regular expression against it, (ab)using Perl's capability to embed code into regular expressions: http://perldoc.perl.org/perlretut.html#A-bit-of-magic:-executing-Perl-code-in-a-regular-expression:
$parts =~ /
^verb(?{ do_something_smart })\s # Statement always starts with a verb
(bareword\s(?{ do_something_smart }))+ # Followed by one or more barewords
| # Or
# Other rules duct taped here
/x;
Whatever I've found so far requires solid knowledge of CS and/or linguistics, and I'm failing to even understand it.
What should I do about lexer output to start understanding and tinker with proper parsing? Something like 'build a set of temporary hashes representing smaller part of statement' or 'remove substrings until the string is empty and then validate what you get'.
I'm aware of the Dragon Book and SICP, but I'd like something lighter at this time.
Thanks!
As mentioned in a couple of comments above, but here again as a real answer:
You might like Parser::MGC. (Disclaimer: I'm the author of Parser::MGC)
Start by taking your existing (regexp?) definitions of various kinds of token, and turn them into "token_..." methods by using the generic_token method.
From here, you can start to build up methods to parse larger and larger structures of your grammar, by using the structure-building methods.
As for actually building an AST - it's possibly simplest to start with to simply emit HASH references with keys containing named parts of your structure. It's hard to tell a grammatical structure from your example given in the question, but you might for instance have a concept of a "command" that is a "verb" followed by some "nouns". You might parse that using:
sub parse_command
{
my $self = shift;
my $verb = $self->token_verb;
my $nouns = $self->sequence_of( sub { $self->token_noun } );
# $nouns here will be an ARRAYref
return { type => "command", verb => $verb, nouns => $nouns };
}
It's usually around this point in writing a parser that I decide I want some actual typed objects instead of mere hash references. One easy way to do this is via another of my modules, Struct::Dumb:
use Struct::Dumb qw( -named_constructors );
struct Command => [qw( verb nouns )];
...
return Command( verb => $verb, nouns => $nouns );

Adding language variable into WWW::Mailchimp (subscription)

I'm trying to work out how I can use WWW::Mailchimp ( http://search.cpan.org/~arcanez/WWW-Mailchimp/ ) to sign someone up to our list, but also assign the language of the person (i.e english, french, german, spanish, etc).
Here is what I have thus far:
my $mailchimp = WWW::Mailchimp->new(apikey => 'xxxx' );
$mailchimp->listSubscribe( id => "xxx", email_address => $in->{Email}, merge_vars => [ FNAME => $name[0], LNAME => $name[1], mc_language => "fr", LANG => "fr", LANGUAGE => "fr" ] );
mc_language => "fr", LANG => "fr", LANGUAGE => "fr" doesn't seem to do anything (been trying all the params I see laying around, in the vain hope one of them works!)
While it works (and asks you to confirm your subscription), all the language variables are ignored. Looking at their documents, I'm a bit confused as to what to use:
https://apidocs.mailchimp.com/api/2.0/lists/subscribe.php
The code "fr" is ok, but I'm unsure what params to pass along to it.
Has anyone had any experience with this before? Apart from the language, it works fine (but I need to be able to send the confirmation emails in their own language, and then also filter down when doing mailings)
UPDATE: Ok, so it looks like its not going to be a simple case of updating to the newer API. I've been looking into the v3.0 API, and its a total overhaul of the older one (new function names, new ways of sending requests, etc). What I'm going to do is look into a "Curl" method, so we can at least get it going with that. Once I've got that going, I'll probably have a look at coding something to work with LWP::UserAgent, as that'd be cleaner than doing lots of curl requests. Shame there isn't anything out there already for Perl and MailChimp (with the new API, or even version 2.0!)
From looking at the source, it defaults to API 1.3:
has api_version => (
is => 'ro',
isa => Num,
lazy => 1,
default => sub { 1.3 },
);
The documentation for that shows you need to use MC_LANGUAGE:
string MC_LANGUAGE Set the member's language preference. Supported
codes are fully case-sensitive and can be found here.
It looks like the module just shoves whatever data structure you provide into JSON and POSTs it to Mailchimp, so the appropriate Mailchimp API doc version for the API you target should be referenced as a primary source.
Ok, so I got there in the end! I have been talking with MailChimp support, and they were very helpful. Turns out it was a double issue.
1) Auto-Translate needed to be enabled for the list in question. This was their answer around that:
After taking a look at the call, it appears to be set up properly now, so you are all good on that front. That being said, I am seeing
that the Auto-translate option doesn't seem to be enabled for any of
your lists. In order for the Confirmation and all other response
emails to automatically translate, this will need to be enabled for
all of the lists being used.
We have a bit of additional information on that, here, if you'd like to check that out:
http://kb.mailchimp.com/lists/signup-forms/translate-signup-forms-and-emails#Auto-Translate-Forms
2) When making the request via the API, you need to specifically set the Accept-Language: xx value. For example, en, fr, es, de, etc.
Here is a working function for anyone who needs it in the future. Just be sure to update the apikey,listId and endpoint URL.
do_register_email_list('foo#bar.com','Andrew Test',"en")
sub do_register_email_list {
# (email,name,lang)
use WWW::Curl::Easy;
use Digest::MD5;
use JSON;
my #name = split /\s+/, $_[1];
my $apikey = 'xxxx-us6';
my $listid = 'xxxx';
my $email = $_[0];
my $endpoint = "https://us6.api.mailchimp.com/3.0/lists";
my $lang = $_[2]||'en';
my $json = JSON::encode_json({
'email_address' => $email,
'status' => 'pending',
'language' => $lang,
'merge_fields' => {
'FNAME' => $name[0]||'',
'LNAME' => $name[1]||''
}
});
my $curl = WWW::Curl::Easy->new;
my $url = "$endpoint/$listid/members/" . Digest::MD5::md5(lc($email));
$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, $url);
# $curl->setopt(CURLOPT_VERBOSE, 1);
$curl->setopt(CURLOPT_USERPWD, 'user:' . $apikey);
$curl->setopt(CURLOPT_HTTPHEADER, ['Content-Type: application/json',"Accept-Language: $lang"]);
$curl->setopt(CURLOPT_TIMEOUT, 10);
$curl->setopt(CURLOPT_CUSTOMREQUEST, 'PUT');
$curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
$curl->setopt(CURLOPT_POSTFIELDS, $json);
# A filehandle, reference to a scalar or reference to a typeglob can be used here.
my $response_body;
$curl->setopt(CURLOPT_WRITEDATA,\$response_body);
# Starts the actual request
my $retcode = $curl->perform;
#print "FOO HERE";
# Looking at the results...
if ($retcode == 0) {
print "Transfer went ok\n";
my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
print "Received response: $response_body\n";
} else {
# Error code, type of error, error message
print "An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n";
}
}
Hopefully this saves someone else from all the grief I had with it :) (the MailChimp support lady also said she will get their team to add something about this in the developer notes, so its made a bit clearer!)

Join attempt throwing exceptions

I'm sure I'm overlooking something glaringly obvious and I apologize for the newbie question, but I've spent several hours back and forth through documentation for DBIx::Class and Catalyst and am not finding the answer I need...
What I'm trying to do is automate creation of sub-menus based on the contents of my database. I have three tables in the database to do so: maps (in which sub-menu items are found), menus (contains names of top-level menus), maps_menus (assigns maps to top-level menus). I've written a subroutine to return a hash of resultsets, with the plan of using a Template Toolkit nested loop to build the top-level and sub-menus.
Basically, for each top-level menu in menus, I'm trying to run the following query and (eventually) build a sub-menu based on the result:
select * FROM maps JOIN maps_menus ON maps.id_maps = maps_menus.id_maps WHERE maps_menus.id_menus = (current id_menus);
Here is the subroutine, located in lib/MyApp/Schema/ResultSet/Menus.pm
# Build a hash of hashes for menu generation
sub build_menu {
my ($self, $maps, $maps_menus) = #_;
my %menus;
while (my $row = $self->next) {
my $id = $row->get_column('id_menus');
my $name = $row->get_column('name');
my $sub = $maps_menus->search(
{ 'id_maps' => $id },
{ join => 'maps',
'+select' => ['maps.id_maps'],
'+as' => ['id_maps'],
'+select' => ['maps.name'],
'+as' => ['name'],
'+select' => ['maps.map_file'],
'+as' => ['map_file']
}
);
$menus{$name} = $sub;
# See if it worked...
print STDERR "$name\n";
while (my $m = $sub->next) {
my $m_id = $m->get_column('id_maps');
my $m_name = $m->get_column('name');
my $m_file = $m->get_column('map_file');
print STDERR "\t$m_id, $m_name, $m_file\n";
}
}
return \%menus;
}
I am calling this from lib/MyApp/Controller/Maps.pm thusly...
$c->stash(menus => [$c->model('DB::Menus')->build_menu($c->model('DB::Map'), $c->model('DB::MapsMenus'))]);
When I attempt to pull up the page, I get all sorts of exceptions, the top-most of which is:
[error] No such relationship maps on MapsMenus at /home/catalyst/perl5/lib/perl5/DBIx/Class/Schema.pm line 1078
Which, as far as I can tell, originates from the call to $sub->next. I take this as meaning I'm doing my query incorrectly and not getting the results I think I should be. However, I'm not sure what I'm missing.
I found the following lines, defining the relationship to maps, in lib/MyApp/Schema/Result/MapsMenus.pm
__PACKAGE__->belongs_to(
"id_map",
"MyApp::Schema::Result::Map",
{ id_maps => "id_maps" },
{ is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
);
...and in lib/MyApp/Schema/Result/Map.pm
__PACKAGE__->has_many(
"maps_menuses",
"MyApp::Schema::Result::MapsMenus",
{ "foreign.id_maps" => "self.id_maps" },
{ cascade_copy => 0, cascade_delete => 0 },
);
No idea why it's calling it "maps_menuses" -- that was generated by Catalyst. Could that be the problem?
Any help would be greatly appreciated!
I'd suggest using prefetch of the two relationships which form the many-to-many relationship helper and maybe using HashRefInflator if you don't need access to the row objects.
Note that Catalyst doesn't generate a DBIC (which is btw the official abbreviation for DBIx::Class, DBIx is a whole namespace) schema, SQL::Translator or DBIx::Class::Schema::Loader do. Looks at the docs of the module you've used to find out how to influence its naming.
Also feel free to change the names if they don't fit you.

What is wrong with my declaration of a hash inside a hash in Perl?

I am struggling with the following declaration of a hash in Perl:
my %xmlStructure = {
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
};
I've been googling, but I haven't been able to come up with a solution, and every modification I make ends up in another warning or in results that I do not want.
Perl complaints with the following text:
Reference found where even-sized list expected at ./configurator.pl line X.
I am doing it that way, since I want to use the module:
XML::Simple
In order to generate a XML file with the following structure:
<settings>
<username></username>
<password></password>
<database></database>
<hostname></hostname>
<dev_table></dev_table>
<octopus>
<alert_dir></alert_dir>
<broadcast_id></broadcast_id>
<subkey></subkey>
</octopus>
</settings>
so sometthing like:
my $data = $xmlFile->XMLout(%xmlStructure);
warn Dumper($data);
would display the latter xml sample structure.
Update:
I forgot to mention that I also tried using parenthesis instead of curly braces for the hash reference, and eventhough it seems to work, the XML file is not written properly:
I end up with the following structure:
<settings>
<dev_table>5L3IQWmNOw==</dev_table>
<hostname>gQMgO3/hvMjc</hostname>
<octopus>
<alert_dir>l</alert_dir>
<broadcast_id>l</broadcast_id>
<subkey>l</subkey>
<system_id>l</system_id>
</octopus>
<password>dZJomteHXg==</password>
<username>sjfPIQ==</username>
</settings>
Which is not exactly wrong, but I'm not sure if I'm going to have problems latter on as the XML file grows bigger. The credentials are encrypted using RC4 algorith, but I am encoding in base 64 to avoid any misbehavior with special characters.
Thanks
{} are used for hash references. To declare a hash use normal parentheses ():
my %xmlStructure = (
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
);
See also perldoc perldsc - Perl Data Structures Cookbook.
For your second issue, you should keep in mind that XML::Simple is indeed too simple for most applications. If you need a specific layout, you're better off with a different way of producing the XML, say, using HTML::Template. For example (I quoted variable names for illustrative purposes):
#!/usr/bin/env perl
use strict; use warnings;
use HTML::Template;
my $tmpl = HTML::Template->new(filehandle => \*DATA);
$tmpl->param(
hostname => '$dbHost',
username => '$dbUsername',
password => '$dbPassword',
dev_table => '$dbTable',
octopus => [
{
alert_dir => '$alert_dir',
broadcast_id => '$broadcast_id',
system_id => '$system_id',
subkey => '$subkey',
}
]
);
print $tmpl->output;
__DATA__
<settings>
<username><TMPL_VAR username></username>
<password><TMPL_VAR password></password>
<database><TMPL_VAR database></database>
<hostname><TMPL_VAR hostname></hostname>
<dev_table><TMPL_VAR dev_table></dev_table>
<octopus><TMPL_LOOP octopus>
<alert_dir><TMPL_VAR alert_dir></alert_dir>
<broadcast_id><TMPL_VAR broadcast_id></broadcast_id>
<subkey><TMPL_VAR subkey></subkey>
<system_id><TMPL_VAR system_id></system_id>
</TMPL_LOOP></octopus>
</settings>
Output:
<settings>
<username>$dbUsername</username>
<password>$dbPassword</password>
<database></database>
<hostname>$dbHost</hostname>
<dev_table>$dbTable</dev_table>
<octopus>
<alert_dir>$alert_dir</alert_dir>
<broadcast_id>$broadcast_id</broadcast_id>
<subkey>$subkey</subkey>
<system_id>$system_id</system_id>
</octopus>
</settings>
You're using the curly braces { ... } to construct a reference to an anonymous hash. You should either assign that to a scalar, or change the { ... } to standard parentheses ( ... ).