I have this problem.
I have solved, it but does it correct for big application (in future:)?
#!/usr/bin/perl
use strict;
use warnings;
use lib '.';
use MyApp;
use LoginFrame;
my $f = LoginFrame->new;
$f->ShowModal;
if(int($f->GetReturnCode)) {
print '['.$f->GetReturnCode."]\n";
$f->Destroy;
my $app = new MyApp;
$app->MainLoop;
} else {
print "PLEASE NOT THIS CRAP AGAIN!!!\n";
print '['.$f->GetReturnCode."]\n";
}
"The ( main ) loop will not terminate until there are top level windows."
wxPerl tutorial http://wxperl.sourceforge.net/tutorial/tutorial2.html#id4690123
Related
File Directory：
/home/wh/perlstudy/perl2/Person/Student.pm
/home/wh/perlstudy/perl2/Person/person.pl
Student.pm
package Student;
use strict;
use warnings FATAL => 'all';
# use utf8;
# binmode(STDIN,"encoding(gbk)");
sub new
{
my $class = shift;
my $self = {
_name => shift, _rank => shift, };
# Print all the values just for clarification.
print "获取学生名字 $self->{_name}\n";
print "获取学生排名 $self->{_rank}\n";
bless $self, $class;
return $self;
}
sub studentRank {
my ( $self, $name ) = #_;
$self->{_name} = $name if defined($name);
return $self->{_name};
}
sub studentName {
my( $self ) = #_;
return $self->{_name};
}
1;
person.pl
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
# use utf8;
# binmode(STDOUT,"encoding(gbk)");
BEGIN(push #INC,"/home/wh/perlstudy/perl2/Person/");
use Student;
my$object = Student->new( "Ana", "9th");
# name which is set using constructor.
my$name = $object->studentName();
print "Name set using constructor is : $name\n";
# name set using helper function.
$object->studentRank( "Anastasia" );
# getting name set by helper function.
$name = $object->studentName();
print "名字 set using helper is : $name\n";
I get:
Prototype after '#' for BEGIN : push #INC,"/home/wh/perlstudy/perl2/Person/" at perlson.pl line 6.
Want to solve the use of perl modules other than #INC.
BEGIN is a code block, so you need curly braces:
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
# use utf8;
# binmode(STDOUT,"encoding(gbk)");
BEGIN {
push #INC, "/home/wh/perlstudy/perl2/Person/";
}
# rest of person.pl goes here
Or you use the -I flag when you call Perl:
perl -I/home/wh/perlstudy/perl2/Person/ person.pl
This has the advantage that you don't have to hard-code the path, but you'll have to re-type it each time. (Or make an alias or shell script for it.)
Or use lib:
use lib "/home/wh/perlstudy/perl2/Person/";
Finally you could install your Perl module in a place where Perl looks for modules by default, but during development you'll have to do that each time you make changes to Student.pm.
I'm creating a script with thread so I had to rebuild perl (perl5.20) with threads support.
Since I have rebuild perl, I have an error :
Can't locate object method "query_form" via package "LWP::UserAgent"
I've tried to re-install LWP::UserAgent, LWP::Simple, URI, but they are up-to-date(according to cpan).
The faulty code :
#!/usr/bin/env perl
package get_xml;
use strict;
use warnings;
use Curses;
use LWP::Simple;
use LWP::UserAgent;
use MIME::Base64;
use URI;
use URI::http;
use HTTP::Request::Common;
use parse_xml;
# ...
sub write_conv_thread{
my ($window, $rows, $username, $url, $ua) = #_;
while(1){
$$url->query_form( # line 43
"heartbeat" => '0',
"conv" => 0,
"username" => "$username",
"active" => 0
);
my $xml = $$ua->get($url);
my #conv = get_conv($xml);
print_all_lines($window, $rows, #conv);
$$window->refresh();
sleep(5);
}
}
1;
And the exact error message : Thread 1 terminated abnormally: Can't locate object method "query_form" via package "LWP::UserAgent" at get_xml.pm line 43.
Code that call the function :
#!/usr/bin/env perl
use strict;
use warnings;
use Curses;
use LWP::Simple;
use LWP::UserAgent;
use MIME::Base64;
use URI;
use threads;
use get_xml;
use post_xml;
# ... initialization of Curses windows ...
# $chat_win is a curse, $row is a number
my $server_endpoint = "...";
my $ua = LWP::UserAgent->new;
my $url = URI->new( "$server_endpoint/index.php" );
my $thread = threads->new(\&get_xml::write_conv_thread, \$chat_win, $row-4,"...", \$url, \$ua);
$thread->detach();
What can I do to make perl find the object method ?
Thank you for your answer.
The (reference to the) UA got assigned to $url instead of $ua.
My best guess as to the cause (since you didn't provide the actual code that gives the error): $window, $rows or $username wasn't provided, causing the (reference to the) UA to be the fourth argument.
I was provided some guidance on here at one time, with the following snippet:
my $q = Thread::Queue->new();
sub worker {
my ($job, $action) = #_;
Build($job, $action);
}
for (1..NUM_WORKERS) {
async {
while (defined(my $job = $q->dequeue())) {
worker($job, 'clean');
}
};
}
$q->enqueue($_) for #compsCopy;
# When you're done adding to the queue.
$q->end();
$_->join() for threads->list();
What is the best option for reusing q? Currently, I'm just making new q objects, q2, q3 and doing all of this over again for each $action that I want to perform. Is there a better way though? I could potentially pass in an array of "actions" that I would like to perform, and would like to avoid duplicating this code 7 times if possible.
Maybe I don't fully understand what a Thread::Queue is..
You should use one queue for one direction. If you just would like to some operation paralel, use one queue. If you would like to report back errors and process those error in main or another thread then you use two queue.
for simple use here is for your reference:
use strict;
use warnings;
use threads;
use threads;
use Thread::Queue;
my $q = Thread::Queue->new(); # A new empty queue
my %seen: shared;
# Worker thread
my #thrs = threads->create(\&doOperation ) for 1..5;#for 5 threads
add_file_to_q('/tmp/');
$q->enqueue('//_DONE_//') for #thrs;
$_->join() for #thrs;
sub add_file_to_q {
my $dir = shift;
my #files = `ls -1 $dir/`;chomp(#files);
#add files to queue
foreach my $f (#files){
# Send work to the thread
$q->enqueue($f);
print "Pending items: "$q->pending()."\n";
}
}
sub doOperation () {
my $ithread = threads->tid() ;
while (my $filename = $q->dequeue()) {
# Do work on $item
sleep(1) if ! defined $filename;
return 1 if $filename eq '//_DONE_//';
next if $seen{$filename};
print "[id=$ithread]\t$filename\n";
$seen{$filename} = 1;
### add files if it is a directory (check with symlinks, no file with //_DONE_// name!)
add_file_to_q($filename) if -d $filename;
}
return 1;
}
I'm trying to make a web server whose requests are farmed out to a set of interpreters hidden behind open2(), based on which 'device' is indicated in the cgi parameters.
The trouble is, I want it multi-threaded but the hash I'm using to try to keep track of the event queue relating to each device doesn't remember the new device created for each request: the server below only prints this sort of thing:
Did not find default-device in (alreadyThere)...
Added default-device with Sun Oct 27 20:43:35 2013 to alreadyThere, default-device
Now... does (alreadyThere, default-device) persist for the next request?
Here is the script:
#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
use base qw(Net::Server::HTTP);
our $monkeys = shared_clone({ alreadyThere => { 'a' => 'b' } });
sub process_http_request {
require CGI;
my $cgi = CGI->new;
my $device = $cgi->param('device') || 'default-device';
print "HTTP/1.0 200 OK\r\nContent-type: text/html\r\n\r\n<pre>";
unless (exists $monkeys->{$device}) {
print "Did not find $device in (".join(", ", sort keys %$monkeys).")...\n";
lock $monkeys;
unless (exists $monkeys->{$device}) {
my $t = localtime;
$monkeys->{$device} = $t;
print "\nAdded $device with ".$t." to ".join(", ", sort keys %$monkeys);
} else {
print "\nSurprise device... ".$device;
}
} else {
print "\nFound device... ".$device;
}
print "\nNow... does (".join(", ", sort keys %$monkeys).") persist for the next request?</pre>";
}
__PACKAGE__->run(port => 8080);
It's not the $t bit - that was previously shared_clone({ id => $t }), but I'm darned if I can see why $monkeys never seems to update.
The different requests are served by different processes, not threads.
Net::Server doesn't have a multi-threaded "personality"[1], so you're going to have to use a different sharing mechanism.
Notes:
"in the near future, we would like to add a 'Thread' personality"
Building on Ikegami's answer, I'm trying with this additional code to fake a 'threaded' personality with some success (and some problems with 'open3' misbehaving):
sub default_server_type { 'Single' }
sub loop {
my $self = shift;
while( $self->accept ){
async {
$self->run_client_connection;
};
last if $self->done;
}
}
a) Is there any reason to use Net::Server::HTTP instead of the higher level and easier to use Plack?
b) I've had to solve a problem not unlike this one recently, and settled on using event-based httpd with AnyEvent (or higher abstraction, Coro). There's Net::Server::Coro if you need a drop-in replacement for your code, or even a plethora of canned AnyEvent-based httpds like Twiggy, Feersum, etc.
I got problem with scalars in my program.
I got code like this:
use threads;
use threads::shared;
use Tk;
$mw = new MainWindow;
my $label = undef;
share($label) my $ok = undef;
share($ok)
HERE IS BUTTON WITH OPTION -command => \&sub1
threads->create('sub2');
sub sub1 {
$top = $mw->TopLevel();
$label = $top->Label( -text => 'something' )->pack();
$ok = 1;
}
sub sub2 {
while (1) {
if ($ok) {
$label->configure( -text => 'i need this' );
$label->update;
}
}
}
I got error in $label->configure(-text => 'i need this'); like this :
Invalid value for shared scalar at xxx.pl
I need to update my label text only from threads and i can't do this.
Thanks for advices.
That error suggests that Tk Label objects simply weren't written to support being shared under ithreads, a circumstance which I'd guess is very arduous to remedy.
I'd suggest instead you make a thread responsible for updating the UI widgets and have that thread receive update instructions from other threads. Awkward, but workable.