using wxperl I want to start a long-lasting function after dragging files to my window. Here is my code for the DropTarget:
package FilesDropTarget;
use strict;
use Wx qw[:allclasses];
use base qw(Wx::FileDropTarget);
sub new {
my $class = shift;
my $caller = shift;
my $fref = shift;
my $this = $class->SUPER::new( #_ );
$this->{caller} = $caller;
$this->{fref} = $fref;
return $this;
}
sub OnDropFiles {
my( $this, $x, $y, $files ) = #_;
&{$this->{fref}}($this->{caller},#$files);
return 1;
}
This module is used via
$frame->{TextControl}->SetDropTarget( FilesDropTarget->new($frame,\&runner) );
(OnDropFiles calls the function &runner() with the dropped files as parameter.)
Everything is fine, except that the drag-source window on Windows is blocked while function &runner() is working, which potentially is a long-lasting operation. The drag-source window becomes useable again after OnDropFiles returns 1, hence after &runner() is ready.
Are there chances to get the drag-source unblocked before &runner() has been finished?
Don't call the function immediately, but postpone doing this until the next event loop iteration. If 3.x CallAfter() is wrapped by wxPerl, you should use it. If not, emulate it manually by using the usual wxEVT_IDLE trick: have a handler for this event checking a flag and calling your function if it's set (and resetting it) and just set this flag in your OnDropFiles().
Related
I am working on a program which makes multiple attempts at processing, storing to a new log each time it tries (several other steps before/after).
use strict;
for (my $i = 0; $i < 3; $i++)
{
my $loggerObject = new MyLoggerObject(tag => $i);
#.. do a bunch of other things ..
Process($loggerObject,$i);
#.. do a bunch of other things ..
}
sub Process
{
my ($logger,$thingToLog) = #_;
sub Logger { $logger->Print($_[0]); }
Logger("Processing $thingToLog");
}
package MyLoggerObject;
sub new
{
my $package = shift;
my %hash = (#_); my $self = \%hash;
return bless $self, $package;
}
sub Print
{
my $self = shift;
my $value = shift;
print "Entering into log ".$self->{tag}.": $value\n";
}
1;
To avoid having to do a bunch of $self->{logger}->Print() and risk misspelling Print, I tried to collapse them into the local subroutine as seen above. However, when I run this I get:
perl PerlLocalMethod.pl
Entering into log 0: Processing 0
Entering into log 0: Processing 1
Entering into log 0: Processing 2
instead of:
perl PerlLocalMethod.pl
Entering into log 0: Processing 0
Entering into log 1: Processing 1
Entering into log 1: Processing 2
I am presuming the problem is that the Logger method is 'compiled' the first time I call the Process method with the object reference I used on the first call but not afterwards.
If I did $logger->Print(), misspelling Print, and hit a codepath I can't reliably test (this is for an embedded system and I can't force every error condition) it would error out the script with an undefined Method. I suppose I could use AUTOLOAD within logger and log any bad Method calls, but I'd like to know any other recommendations on how to make sure my Logger() calls are reliable and using the correct object.
In Perl, subroutines are compiled during compile time. Embedding a named subroutine declaration into a subroutine doesn't do what one would expect and isn't recommended.
If you are afraid of typos, write tests. See Test::More on how to do it. Use mocking if you can't instantiate system specific classes on a dev machine. Or use shorter names, like P.
You can declare the Logger in the highest scope as a closure over $logger that you would need to declare there, too:
my $logger;
sub Logger { $logger->Print($_[0]) }
But it's confusing and can lead to code harder to maintain if there are many variables and subroutines like that.
If you had used use warnings in your code you would have seen the message:
Variable "$logger" will not stay shared at logger line 24.
Which would have alerted you to the problem (moral: always use strict and use warnings).
I'm not entirely sure why you need so many levels of subroutines in order to do your logging, but it seems to me that all of your subroutines which take the $logger object as their first parameter should probably by methods on the MyLoggerObject (which should probably be called MyLoggerClass as it's a class, not an object).
If you do that, then you end up with this code (which seems to do what you want):
use strict;
use warnings;
for my $i (0 .. 2) {
my $loggerObject = MyLoggerClass->new(tag => $i);
#.. do a bunch of other things ..
$loggerObject->Process($i);
#.. do a bunch of other things ..
}
package MyLoggerClass;
sub new {
my $package = shift;
my $self = { #_ };
return bless $self, $package;
}
sub Process {
my $self = shift;
my ($thingToLog) = #_;
$self->Logger("Processing $thingToLog");
}
sub Logger {
my $self = shift;
$self->Print($_[0]);
}
sub Print {
my $self = shift;
my ($value) = #_;
print "Entering into log $self->{tag}: $value\n";
}
1;
Oh, and notice that I moved away from the indirect object notation call (new Class(...)) to the slightly safer Class->new(...). The style you used will work in the vast majority of cases, but when it doesn't you'll waste days trying to fix the problem.
As already explained above, using lexical defined variables in these kinds of method is not possible.
If you have to "duct-tape" this problem you could use global Variables (our instead of my).
sub Process
{
our ($logger,$thingToLog) = #_;
sub Logger { $logger->Print($_[0]); }
Logger("Processing $thingToLog");
}
But be aware that $logger and $thingToLog are now global variables accessible outside this function.
I need to instantiate a new $dbh using DBI.
My objects usually have a $dbh present when they're created.
When I try to create a new $dbh using
my $dbh = MyLib::Connect();
and after performing some DB operations doing
$dbh->disconnect();
my downstream code's $dbh is closed. Is there a way to get what I'm after? I've seen some example code that does two DBI->connect(...) calls but using the same code as an example produces the same result - it's like MyLib is caching the returned $dbh value.
Example code:
package MyLib;
sub DoConnect {
...
my $dbh = DBI->connect(...);
return($dbh)
}
package Object;
sub GetData {
my ($id) = #_;
my $dbh = MyLib::DoConnect(); # This should be separate
...
$dbh->commit()
$dbh->disconnect();
return($someData);
}
package AnotherObject;
sub DoSomething {
my ($self) = #_;
# $self had a dbh set on instantiation with MyLib::DoConnect();
my $newData = Object::GetData($self->id);
my $moreData = GetDataUsingDBH($self->dbh); # the dbh is closed!!!
}
Is what I need to do possible without starting a separate thread (which I can't guarantee will finish before GetDataUsingDBH is called). Should I do a system call to an external program to wait for it to finish? Does my question even make sense?
The approach you describe works fine.
package MyLib;
use DBI qw( );
sub DoConnect {
return DBI->connect(
'dbi:SQLite:foo.sqlite3', undef, undef,
{ PrintError=>0, RaiseError=>1 },
);
}
package Object;
sub new {
my $class = shift;
my $self = bless({}, $class);
return $self;
}
sub GetData {
my $dbh = MyLib::DoConnect();
$dbh->disconnect();
}
package AnotherObject;
sub new {
my $class = shift;
my $self = bless({}, $class);
$self->{dbh} = MyLib::DoConnect();
return $self;
}
sub DoSomething {
my ($self) = #_;
return $self->{dbh}->selectrow_array("SELECT 'abc'");
}
package main;
my $ao = AnotherObject->new();
my $o = Object->new();
$o->GetData();
print $ao->DoSomething(), "\n";
Output:
abc
Something else you didn't mention is causing the problems.
I figured it out. I setup my DBHs to be shared by all of my objects in the executable so I don't have to instantiate one DBH and pass it around to my objects manually - this ruined the behavior I was expecting when I actually needed to do this.
Thanks for all of your help, folks - learned a bunch.
Are you certain DoConnect is calling DBI->connect, not DBI->connect_cached, or something else that is caching database handles?
If so, I'm guessing you have Apache::DBI loaded and are running under mod_perl (or at any rate have $ENV{MOD_PERL} set), which causes DBI->connect to use Apache::DBI to cache connections.
You can tell DBI to not do this by calling connect with a dbi_connect_method attribute:
DBI->connect( $data_source, $username, $auth, {
'dbi_connect_method' => 'connect',
} );
(which would require you to pass something into your DoConnect saying that's what you want).
That is the documented way; an undocumented way that may work for you is to locally set the variable that DBI uses as the default for that attribute:
# This should be separate
my $dbh = do { local $DBI::connect_via = 'connect'; MyLib::DoConnect() };
(I guess it is possible even if you don't have $ENV{MOD_PERL} set when you load DBI that your code is already setting $DBI::connect_via to 'connect_cached' or some other package and that is causing your trouble.)
Another approach, if you don't actually need to use the two database handles at the same time, would be to just remove the disconnect call. When $dbh goes out of scope, if there are no other copies of that database handle around, it will be closed; explicitly calling disconnect isn't necessary.
I try to create an object inside my perl Script. Therefore I have a constructor
new(;#)
{
my $class = shift;
my $self = {};
bless $self, $class;
$self->_init(#_);
return $self;
}
And my _init(;#) Function, to initialise the object
my $self = shift;
if( #_ )
{
my %extra = #_;
#$self{keys %extra} = values %extra;
}
return;
Am I using this two functions the wrong way? I am starting every other sub with the two lines
my $self = shift;
croak "instance method called for class" unless ref $self;
But I get only syntax / String found where operator expected errors in return for every single time I am using it.
Therefore my Question: Am I using the two functions the right way? I always thought I only need to initialise $self once, like I did, and can point everything I want to it for the rest of the Script.
croak is not loaded by default. You must use Carp in the package to be able to use it (see Carp).
BTW, prototypes are ignored with method calls. Don't use them. Don't use them for functions, either.
You might use something like Class::Declare::Attributes to save some typing:
sub new :class {
...
}
I am trying to find the problem and propose a solution for the following Perl code.
A file without strict nor warnings on it has a function that uses a $variable without declaring it. So that variable is global to the file and the changes for that variable in this specific function are used outside of it (since it is global for the file).
Due to a recent update, this old_file now requires a modified version of itself (new_file) in which the same function is defined. But this new version has strict and warnings, so the same variable is defined, but this time as 'my' in the new function, and is returned in the end.
The tricky thing is that the code in the old_file did not change so it still expects the variable to be changed as its own global variable.
Since I don't know Perl well enough to be able to determine which version of this function is used (and since I can't test it, due to IT restrictions) I need an explanation of the behavior, possibly a link to a good paper about that topic.
Code: (I think the problem is in the variable LISTEREPONSE from the function start_handler.)
old_file:
use XML::Parser;
my $parser = new XML::Parser( ErrorContext => 2 );
$parser->setHandlers(
Start => \&start_handler,
End => \&end_handler,
Char => \&char_handler
);
$parser->parse(<$remote>);
close $remote;
...
sub start_handler {
my $expat = shift;
my $element = shift;
print;
while (#_) {
my $att = shift;
my $val = shift;
$LISTEREPONSE .= "$att=$val&";
}
}
new_file:
sub start_handler {
my $expat = shift;
my $element = shift;
print;
my $LISTEREPONSE;
while (#_) {
my $att = shift;
my $val = shift;
$LISTEREPONSE .= "$att=$val&";
}
return $LISTEREPONSE;
}
In strict mode, if you need $LISTEREPONSE become a global variable in package(file) scope.
Just declare (my $LISTEREPONSE;) in the beginning of file (after use).
In second case, $LISTEREPONSE is declare in sub, it's lexical scope and only available in sub.
my $LISTEREPONSE;
# ...
sub some_sub {
$LISTEREPONSE .= $some_stuff;
}
For learning purposes, I am toying around with the idea of building
event-driven programs in Perl and noticed that it might be nice if a
subroutine that was registered as an event handler could, on failure,
just schedule another call to itself for a later time. So far, I have
come up with something like this:
my $cb;
my $try = 3;
$cb = sub {
my $rc = do_stuff();
if (!$rc && --$try) {
schedule_event($cb, 10); # schedule $cb to be called in 10 seconds
} else {
do_other_stuff;
}
};
schedule_event($cb, 0); # schedule initial call to $cb to be performed ASAP
Is there a way that code inside the sub can access the coderef to that
sub so I could do without using an extra variable? I'd like to
schedule the initial call like this.
schedule_event( sub { ... }, 0);
I first thought of using caller(0)[3], but this only gives me a
function name, (__ANON__ if there's no name), not a code reference
that has a pad attached to it.
__SUB__ has been added in 5.16, providing this usability.
I think Sub::Current will fix your problem.
To get a reference to the current subroutine without using an extra variable, you can use a tool from functional programming, the Y-combinator, which basically abstracts away the process of creating the closure. Here is a perlish version:
use Scalar::Util qw/weaken/;
sub Y (&) {
my ($code, $self, $return) = shift;
$return = $self = sub {$code->($self, #_)};
weaken $self; # prevent a circular reference that will leak memory
$return;
}
schedule_event( Y { my $self = shift; ... }, 0);
If you don't change $cb's value again, you can use that. If not, define a scalar to hold that and don't change it ever again. For example:
my $cb = do {
my $sub;
$sub = sub { contents using $sub here }
}
Using a fixed-point combinator, you can write your $cb function as if the first argument was the function itself:
sub U {
my $f = shift;
sub { $f->($f, #_) }
}
my $cb = sub {
my $cb = shift;
...
schedule_event(U($cb), 10);
...
}
schedule_event(U($cb), 0);