Perl Tk: confusion with updating a text window - perl

I have a small Perl Tk app with a text window that I want to be updated in a non buffered way like I have with my log files but I can't get it to work due to my poor understanding of everything to do with Perl.
The app reads an xml index, parses it then loads each id found in the xml as a url to cache the page. These can number from 1700 to 19,000 depending on which $pubId is entered and takes a couple of hours.
I have the following code for the Submit button and the text window:
my $submit_image = $pict->Photo(-file => $submit);
my $submit_button = $mw->Button(
-image => $submit_image,
-text => "Submit",
-background => "#cccccc",
-command => sub {
if ($pubId eq '') {
$|;
Log_message ("\n$DATE - $TIME - WARNING: Please complete all fields\t");
tk_message ("Please enter a valid Publication ID");
}
else {
request_url(); #Open the xml url and read it in
}
$text->insert(
# put something to the _end_ of the text
# which is in the widget
'end',
sprintf(" $txtmesg\n")
);
# Set window to the end of the text
# I want to see the newest events immediately
$text->see('end');
}) ->place( -x => 60, -y =>195);
which works if the button is pressed with an empty or invalid $pubId (request_url does a further check to see if the html body contains the word 404 and errors out a message to the window).
But if everything is ok and request_url() runs, then the whole Tk window freezes and I can't use my exit button and have to close it via the command prompt.
I know I should be doing this differently but so far every site I have looked at is too complicated for me and I just get baffled. I'm looking for some noddy instructions to enable me to work through this.
Thanks.
EDIT: I have now tried to use MainLoop(); and the DoOneEvent(): within my sub but I am still seeing the same gui freeze and no window updates.
I will continue to research and experiment.
-command => \&long_job)
MainLoop();
sub long_job {
if ($pubId eq '') {
$|;
Log_message ("\n$DATE - $TIME - WARNING: Please complete all fields\t");
tk_message ("Please enter a valid Publication ID");
}
else {
DoOneEvent();
request_url(); #Open the xml url and read it in
}
}

Not sure if this will help others with a similar problem, but just in case it does:
MainLoop();
is what "starts" the tk process. Good practice would be to set up all your widgets, callbacks and anything you want to show up on screen first, then call the MainLoop(). Processing should occur after the MainLoop() is called. In the above, you will probably need to call
$myLabel->update;
inside the loop on whatever it is you are using to display your output. In my case I was using a Label to output progress messages in a loop that made calls using system(). Using ->update solved it perfectly (while DoOneEvent() did not).
Hope that helps somebody out there.

Related

How do I get the text in an alert/prompt/dialog in perl with selenium webdriver?

I want to get a string in the picture below. It is inside of an alert, prompt or dialog. My code is written in Perl and I am using Selenium Webdriver to navigate through the page.
What I have achieved so far:
finding the link with selenium and clicking on it
waiting for the alert to appear
get a string from the alert, but not the string in the text field
Code
my $copy_elem = wait_until {
$d->find_element_by_id('clipboard-link');
};
$copy_elem->click;
select undef, undef, undef, 8.00;
my $alert = wait_until {
$d->get_alert_text;
};
$alert output is "Copy Link"
So the text that I want is inside the alert's text field. With get_alert_text I only get the Alert string, but not the text field content. I searched the Web for answers and saw people using window handles to switch to the alert. I tried to look for similar functions in Selenium Webdriver's documentation:
CPAN Selenium Webdriver Docu with list of functions
I tried getting the window handles and load them into an array, but it does not get a second window handle for the alert. get_current_window_handle doesn't work either. I used phantomjs and chrome as browsers. As far as I know there is no driver.switchto().alert(); for perl.
One way is to override the prompt function in the page with a script injection:
# override the prompt function
$d->execute_script('window.prompt=function(message, input){window.last_prompt = {message: message, input: input}};');
# trigger a prompt
select undef, undef, undef, 8.00;
# get the prompt default input
my $input = $d->execute_script('return window.last_prompt.input;');

Can Perl monitor for pop-up and automatically select Yes?

I have the below code embedded in a script where I can inserting records into a database through the business logic layer. When I ran the script a Win32 dialog box popped up and asked me a question in which I responded yes. This dialog box is only presented to the user if certain values are entered into the database. So it's a problem only a percentage of the time. Is there a command to embed in my script which ignores pop-ups with a default Yes response? Or is there a way to have the script respond and continue processing? I'm not seeing much on this topic when googling and searching this site. Perhaps there is and I'm searching the wrong phrase. If this is not possible I can have the business logic programmers put an exception for the role my script will run under.
#Process each action required to update the State field
foreach $action (#performAction) {
$entity->EditEntity($action);
#Evaluate for validation errors
$trappedErrorValidate = $entity->Validate();
if ($trappedErrorValidate ne "") {
print ERRFILE "The State field has not been updated from $startState to $finishState for record number #fieldValues[0] due to the error code below.\n";
print ERRFILE "Error Code:$trappedErrorValidate\n";
print ERRFILE "*********************************************************************************\n";
$entity->Revert();
} else {
#Commit and evaluate for errors
$trappedErrorCommit =$entity->Commit();
if ($trappedErrorCommit ne "") {
print ERRFILE "The State field has not been updated from $startState to $finishState for record number #fieldValues[0] due to the error code below.\n";
print ERRFILE "Error Code:$trappedErrorCommit\n";
print ERRFILE "*********************************************************************************\n";
}else {
$stateChanges++;
}
}
}
Do you have code in your ClearQuest hooks to pop up the dialog? These are not coming from the script you pasted, so they must be coming from the hooks.
What you could do is set a session variable in your script, e.g.
$session->SetNameValue("RUNNING_IN_SCRIPT", "true");
Then in your hook code have this:
my $runningInHook = $session->GetNameValue("RUNNING_IN_SCRIPT");
my $suppressPopup = $runningInHook eq "true";
Then anywhere you might do the popup, check if $suppressPopup, and assume "yes" instead of trying to pop up a dialog.

How can I write a Perl script to automatically take screenshots?

I want a platform independent utility to take screenshots (not just within the browser).
The utility would be able to take screenshots after fixed intervals of time and be easily configurable by the user in terms of
time between successive shots,
the format the shots are stored,
till when (time, event) should the script run, etc
Since I need platform independence, I think Perl is a good choice.
a. Before I start out, I want to know whether a similar thing already exists, so I can start from there?
Searching CPAN gives me these two relevant results :
Imager-Screenshot-0.009
Imager-Search-1.00
From those pages, the first one looks easier.
b. Which one of these Perl modules should I use?
Taking a look at the sources of both, Imager::Search isn't much more than a wrapper to Imager::Screenshot.
Here's the constructor:
sub new {
my $class = shift;
my #params = ();
#params = #{shift()} if _ARRAY0($_[0]);
my $image = Imager::Screenshot::screenshot( #params );
unless ( _INSTANCE($image, 'Imager') ) {
Carp::croak('Failed to capture screenshot');
}
# Hand off to the parent class
return $class->SUPER::new( image => $image, #_ );
}
Given that Imager::Search does not really extend Imager::Screenshot much more, I'd say you're looking at two modules that are essentially the same.

Zend Lucene displays blank screen when no results found

When I submit a query to Zend_Lucene with a string that exists in the index, the results are displayed as expected, however when string is not found, I get a blank page with no error messages. Code used as below:
require_once 'Zend/Feed.php';
require_once 'Zend/Search/Lucene.php';
$index = Zend_Search_Lucene::open('data/my-index');
$queryStr ='fjkhsdkdfh';
$hits = $index->find($queryStr);
if ($hits) {
foreach ($hits as $hit) {
echo $hit->page_title;
}
} else {
echo 'No results found.';
}
I would expect 'No results found' to appear, but instead I get a blank page with no error messages.
What confuses me more is that I have this tested and working locally, but when on a live server it stops working.
Locally I have Zend Server 4 installed, remotely PHP 5.2.11 and ZF 1.10.2
Any help much appreciated!
Paul
I actually found a work around to this that involved processing the entire routine through a single page. As I was calling in external functions to generate the querys for some reason a blank page was always returned. By placing all script on one page I was able to have results displayed.

How can I fix the "Couldn't create file parser context for file ..." bug with Perl libxml on Debian?

When I try to read an XML file with XML::Simple, sometimes I get this error message:
Couldn't create file parser context for file ...
After some googling, it seems to be a problem with libxml-libxml-perl and is supposed to be fixed in the version I use (1.59-2).
Any ideas?
Edit: (code)
sub Read
{
my ($file, $no_option) = #_;
my %XML_INPUT_OPTIONS = ( KeyAttr => [], ForceArray => 1 );
if ((defined $file) && (-f $file))
{
my #stats = stat($file);
if ((defined $XML_CACHE{$file})
&& ($stats[9] == $XML_CACHE{$file}{modif_time}))
{
return ($XML_CACHE{$file}{xml});
}
else
{
my $xml = eval { XMLin($file,
(defined $no_option ? () : %XML_INPUT_OPTIONS)) };
AAT::Syslog("AAT::XML", "XML_READ_ERROR", $#) if ($#);
$XML_CACHE{$file}{modif_time} = $stats[9];
$XML_CACHE{$file}{xml} = $xml;
return ($xml);
}
}
return (undef);
}
And yes, I should & will use XML::Simple cache feature...
Does the error continue "No such file or directory at..."? If so, then I think that the problem is that (for whatever reason) when you get to that point in the script, whatever you are passing to XML::Simple has no xml file in it. Long story short, the script you are using may be passing a bad variable (blank? empty?) to XML::Simple at which point the module chokes. To debug, add a check on whatever you hand to XML::Simple before you pass it along. (See the next paragraph for a concrete example explaining why I think this may be your problem.)
A few months ago, I had a similar problem with Weather::Google. In a nutshell, the weather module was trying to get data from Google via LWP::Simple without a user agent. Google began (apparently) to reject requests without a user agent. I had to backtrack through the modules because the error appeared to come from XML::Simple. In fact, it was caused by what was done in LWP::Simple and Weather::Google. Or rather, the error was a result of Weather::Google not checking the data that was in an object created via LWP::Simple. In a case like this, it can be hard at first to see what's going wrong and where.