Hi Guys need some help regarding modules and emptying dynamically created array in another module.
I have 1 perl file, and 2 perl modules ( i have created )
//file.pl
use ABC;
use XYZ;
for(qw/US UK China India France/)
{
ABC::fetchData // This will create array varialbes
XYZ::calculateYield
// This will use arrays dynamically created from fetchData
// At this point, when i return I want a new copy of the array used in XYZ.pm's calculateYield function
}
This is a an example of ABC.pm
//ABC.pm
package ABC;
our #mainArray;
sub fetchData
{
// connect to database and fill up the #mainArray;
#mainArray = qw/a b c d e f/;
}
1;
This is an example of XYZ.pm
//XYZ.pm
package XYZ;
sub calculateYield
{
foreach my $eachelement ( #ABC::mainArray)
{
push #{$eachelement), "some_data_that_changes_every_time_from India, UK, US, France or China";
}
}
Now, the problem lies here, I want to empty out the array "#{$eachelement}" after every call of for(1..5) , because the $eachelement stays the same in every count. Only the value of the data that is pushed into push #{$eachelement) in the XYZ module changes depending on the value ( US, UK, China, India, France).
Question for the group is, is there a way to empty out an array in a module whose name is dynamically created. As for example i want to clear out #{$eachelement} in the XYZ.pm after everytime the for loop is done.
Hope I have put it in a way that can be understood. If anyof you have a better solution or something else I can use,I am willing to do that. Ping me back if the question or any part of the code is not clear.
PS : I am not looking for a small error or typo, this is just a sample code. I just want to know how things can be done.
Thanks for the much anticipated help in advance.
I looked around and found a solution to this particular problem. I defined a global function
sub clear
{
for my $ref (values %MSQL::)
{
#{$ref} = ();
}
}
Thanks Guys for the support.
#Patrick , this was not a TYPO error. Like I said I was looking for the logic.
Related
My perl code makes a call to an API, passing a reference to an array of string IDs, and expects to get an array of objects back.
my #customers = $api->get_customer_details(\#customer_ids);
for my $customer (#customers) {
# debug
print $customer . "/n";
print ref($customer) . "/n";
print Dumper ($customer);
if (!$customer) {
print "No customer object\n";
# do stuff
last;
}
print "Got the customer object\n";
$info->{customer_objects}{$customer->customer_id} = $customer;
}
99% of the time, when I run this I get customer objects back. However, I'll occasionally get the output:
HASH(0x12345)
HASH
{}
Got the customer object
Can't call method "customer_id" on unblessed reference at ..
I've tried to edit my IF statement to check for an empty hashref, but it will always ignore the IF:
if (!$customer || !%$customer)
When I test this out via command line, the empty hashref works as expected:
$ perl -E 'my $hr = {}; if (!$hr || !%$hr) { say "empty" } else { "nonempty" }'
empty
I'm not understanding what the issue is. It appears that my debug output isn't accurate, and I am actually not getting an empty hashref. Can someone please explain what is going on, and how I might figure out exactly what $customer is and how to ignore this case in my IF statement?
You can check blessed, as you see in the comments to the question.
However, it looks like you might have some cases where you query a particular ID, but there's no record for that ID. Maybe that's not the case, so just ignore this if it's not even close to the cause.
In that case, you might get back something that's not a customer object (because there is no customer). I'd much rather push that complexity down so the application doesn't have to think that hard about it and I catch it sooner.
This work probably happens in get_customer_details.
The trick then is to figure out how to represent the customer that does not exist. One way is to simply have get_customer_details not return anything for a non-existent ID. The returned list simply does not have those entries. Then there's no problem with later method calls. However, you then have silent failures and you can get fewer items than the arguments you supplied.
Another way is to return undef in the list, then look for defined values. The undef positions would correlate to the bad customer ID in the #customer_ids, and you can handle that .
my #customers = $api->get_customer_details(\#customer_ids);
for( my $i = 0; $i < #customers; $i++ ) {
unless( defined $customers[$i] ) {
warn "No customer for $customer_ids[$i]";
next;
}
...
}
But I tend to favor something where there's a parallel object that acts like the null customer. That would be able to tell you that there was no customer, what the ID was, and so on. It might respond to all the normal customer methods, but warn and return undef (or die, or whatever). There might be some method to tell you which objects are real customers, like exists (or some better name):
my #customers = $api->get_customer_details(\#customer_ids);
foreach my $customer ( #customers ) {
unless( $customers->exists ) {
# this would be a Customer::Null or something
# that responds to the same methods
warn "No customer for " . $customer->id";
next;
}
...
}
I think this last approach because as these objects pass through the program, they carry with them the story of their creation. These things might even store the part of the API data structure so you can see what's going on. Maybe there is a customer but whatever turns it into a Customer doesn't understand something about it.
I am trying to filter a liststore using the GTK2::TreeModelFilter. I can't seem to find an example online that uses perl and I am getting syntax errors. Can someone help me with the syntax below? The $unfiltered_store is a liststore.
$filtered_store = Gtk2::TreeModeFilter->new($unfiltered_store);
$filtered_store->set_visible_func(get_end_products, $unfiltered_store);
$combobox = Gtk2::ComboBoxEntry->new($filtered_store,1);
Then somewhere below:
sub get_end_products {
my ($a, $b) = #_;
warn(Dumper(\$a));
warn(Dumper(\$b));
return true; # Return all rows for now
}
Ultimately what I want to do is look at column 14 of the listore ($unfiltered_store) and if it is a certain value, then it filtered into the $filtered_store.
Can someone help me with the syntax on this? I checked a bunch of sites, but they're in other languages and using different syntax (like 'new_filter' -- doesn't exist with Perl GTK).
This is the most elegant solution to a fix I need to make and I would prefer to learn how to use this rather than using a brute force method of pulling and saving the filtered data.
The set_visible_func method of the filtered store should get a sub reference as the first argument, but you are not passing a sub reference here:
$filtered_store->set_visible_func(get_end_products, $unfiltered_store);
This will instead call the sub routine get_end_products and then pass on its return value (which is not a sub reference). To fix it add the reference operator \& in front of the sub name:
$filtered_store->set_visible_func(\&get_end_products, $unfiltered_store);
Regarding your other question in the comments:
According to the documentation the user data parameter is passed as the third parameter to get_end_products, so you should define it like this:
sub get_end_products {
my ($model, $iter, $user_data) = #_;
# Do something with $user_data
return TRUE;
}
If for some reason $unfiltered_store is not passed on to get_end_products, you can try pass it using an anonymous sub instead, like this:
$filtered_store->set_visible_func(
sub { get_end_products( $unfiltered_store) });
Question Updated
I have list of (few more) regex patterns like: (Note: Sequence is very Important)
([a-z]+)(\d+)
\}([a-z]+)
([a-z]+)(\+|\-)
([0-9])\](\+|\-)
...
...
my input file like :
\ce{CO2}
\ce{2CO}
\ce{H2O}
\ce{Sb2O3}
...
...
In my code I am finding the each and every regex patterns like
if($string=~m/([a-z]+)(\d+)/g) { my statements ... }
if($string=~m/\}([a-z]+)/g) { my statements ... }
if($string=~m/([a-z]+)(\+|\-)/g) { my statements ... }
if($string=~m/([0-9])\](\+|\-)/g) { my statements ... }
Instead of doing the above code Is there any other way to simplify the code?
Could you someone please share your thoughts for my improvement for better coding.
Disclaimer: Your question is very hard to read, so this is pretty much guesswork. I am not sure I understand what you want to do.
When you are processing data in a dynamic way, a typical approach is to use a dispatch table. We can do something similar here. Often a hash or hash reference is used for that, but since we want a specific order, I will be using an array instead.
my #dispatch = (
{
pattern => qr/f(o)(o)/,
callback => sub {
my ($one, $two) = #_;
print "Found $one and $two\n";
},
},
{
pattern => qr/(bar)/,
callback => sub {
my $capture = shift;
print "Saw $capture";
},
},
);
This basically is a list of search patterns and associated instructions. Each pattern has a callback, which is a code reference. I decided it would make sense to pass in the capture variables, because your patterns have capture groups.
Now in order to call them, we iterate over the dispatch array, match the pattern and then call the associated callback, passing in all the captures.
my $text = "Foo bar foo bar baz.";
foreach my $search (#dispatch) {
if ($text =~ $search->{pattern}) {
$search->{callback}->(#{^CAPTURE}); # this requires Perl 5.26
}
}
Please note that I am using #{^CAPTURE}, which was added to Perl in version 5.25.7, so you would require at least the stable Perl 5.26 release to use it. (On an older Perl, my #capture = $t =~ $search->{pattern} and $search->{callback}->(#capture) will behave similarly).
This is way more elegant than having a list of if () {} statement because it's very easy to extend. The dispatch table could be created on the fly, based on some input, or entirely read from disk.
When we run this code, it creates the following output
Found o and o
Saw bar
This is not very spectacular, but you should be able to adapt it to your patterns. On the other hand I don't know what you are actually trying to do. If you wanted to modify the string instead of only matching, you might need additional arguments for your callbacks.
If you want to learn more about dispatch tables, I suggest you read the second chapter of Mark Jason Dominus' excellent book Higher Order Perl, which is available for free as a PDF on his website.
Your question is hard to read, mainly because you have the /g at the end of your regex searches (which returns a list), however, you only check if it matches once.
I'm making the following assumptions
All matches are required
the code can be a single or double match
both groups captured in one line
i think you want
while ( $string =~ /(([a-z]+)(\d+)|\}([a-z]+)|([a-z]+)(\+|\-)|([0-9])\](\+|\-))/g )
{
#$1 has the whole match
#$2 has the first group if defined
#$3 has the second group if defined
}
However, I prefer the method below. this will capture in one line
while ($string =~ /([a-z]+\d+|\}[a-z]+|[a-z]+\+|\-|[0-9]\]\+|\-)/g )
{
# in here split the match if required
}
I recommend you use regex comments to make this clearer.
if you just want a single match, use
if(
$string=~m/([a-z]+)(\d+)/ ||
$string=~m/\}([a-z]+)/ ||
$string=~m/([a-z]+)(\+|\-)/ ||
$string=~m/([0-9])\](\+|\-)/
)
{
#some code
}
Using DBIx::Class I am trying to manipulate the data of a column whenever it is being updated or retrieved. For instance, before it goes into the database I would like to encrypt it, and whenever it is being accessed I would like to decrypt it. I am following this example in the DBIx::Class::Manual::Cookbook, however I can't seem to get it to work. I have placed the following in my User schema. For testing I am just using the name column, I know it doesn't make sense:
__PACKAGE__->add_columns("name" => { accessor => '_name' });
sub name {
my $self = shift;
# If there is an update to the column, we'll let the original accessor
# deal with it.
if(#_) {
return $self->_name('test 1');
}
# Fetch the column value.
my $name = $self->_name;
$name = 'test 2';
return $name;
}
I can't see what I'm doing any different than what the cookbook says. Can't anyone help me understand what I'm doing wrong? Thanks!
DBIx::Class has a component for that called FilterColumn.
There are various modules on CPAN using that component like DBIx::Class::EncodedColumn and PassphraseColumn.
If you tell us what you use case is we might give you more/better suggestions.
I have a ListBox in a Windows app that lists the people in a chat session. This is defined as follows:
Win32::API::Struct->typedef('UserItem', qw {
USHORT uid;
TCHAR realName[256];
TCHAR aliasName[256];
}
) or die "Typedef error $! \n";
my $user_data = Win32::API::Struct->new('UserItem');
Now I want to send a LB_GETITEMDATA message to the window to the get the attendee item details defined by the struct.
Using Win32::API, I do this:
my $LB_GETITEMDATA = 0x0199;
my $SendMessage = Win32::API->new("user32", "SendMessage", "NNNN", "S");
... # Here is the code to find the window handle, which is $hwnd.
$user_data = $SendMessage->Call($hwnd, $LB_GETITEMDATA, 0, 0); # Get the first item.
Now, I'd think $user_data struct will contain the first item's details, but it is actually undef & I don't get any LB_ERR either. What am I doing wrong?
That makes no senses to me. How can Win32::API know what kind of struct is being returned by SendMessage if you don't tell it? It can't possibly create the right type of object from the information you provided it.
I see nothing on how to use "S" for the return value. I think you might have to use the prototype interface if you want to return value to be unpacked into a ::Struct object. That's the only one documented.
But before you start messing with that, change the return type to "N" and see if you get a pointer back. If you get zero, it could be a problem with the listbox or with the arguments (particularly, the handle or the message number, since "NNNN" looks right to me), and you should fix that first. Then you can worry about the return value if it's still a problem.
If it is a problem with getting ::Struct to work, you could always unpack the
structure yourself.
# Use "N" for return.
my ($uid, $realName, $aliasName) =
unpack('S Z256 Z256', # Unpack fields of structure.
unpack('P514', pack('J', $rv))); # Get bytes of the structure.
You have to set the item data with LB_SETITEMDATA after adding the string. The data is just a pointer sized value so each $user_data struct has to exist in memory as long as the item exists in the list...