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

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.

Related

How do I update a custom Bugzilla field in a custom Bugzilla extension using Perl?

I have a custom field in Bugzilla that I need to update after making a JSON call to another server after a bug has been updated. I am able to make the call and get the response back, but attempting to update the bug is failing.
I have tried setting the field in the hooks bug_end_of_update and object_end_of_set_all and it hasn't worked at all. If I attempt to do it in bug_end_of_update, the object itself gets updated in memory, but it will never get set in the database. Calling update on the $bug object in that method sends Bugzilla into an infinite loop that requires a complete restart to fix. In the code below, I am able to update the assigned_to field correctly. Using the same exact call doesn't work for a custom field though.
sub object_end_of_set_all {
my ($self, $args) = #_;
my $object = $args->{'object'};
if ($object->isa('Bugzilla::Bug')) {
$object->{'assigned_to'} = $object->{'reporter_id'}; #this works
$object->{'cf_custom_field'} = 'hello world'; #this doesn't
my $blessedField = {cf_custom_field};
bless $blessedField;
$object->set($blessedField, 'hello world'); #also doesn't work
$object->update; #puts bugzilla into an infinite loop that never returns
}
}
I would expect setting a custom field would work exactly like assigned_to, but it doesn't and the documentation on this is extremely lacking.

Perl Tk: confusion with updating a text window

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.

Why does this conditional redirect in Catalyst not work?

I have a Catalyst application and would like to redirect based on a conditional statement. I am having trouble with this and I'm wondering if anyone might have insight into why this seemingly easy task is proving difficult.
In my Root.pm module I have a sub begin and can redirect to another website, e.g. www.perl.org, but I am unable to redirect to a page within my application. Any thoughts on how to do a conditional redirect?
sub begin : Private {
my ( $self, $c ) = #_;
$c->stash->{client_id} = somenumber; # I'm setting this manually for testing
$c->res->redirect('http://www.perl.org/') unless $c->stash->{client_id};
$c->res->redirect('http://www.mysite.com/success') if $c->stash->{client_id}; #does not
}
Maybe you're getting stuck in an infinite loop, in which your begin sub redirects the user to another page in your Catalyst application; once "the controller that will run has been identified, but before any URL-matching actions are called" (from the Catalyst::Manual::Intro man page), begin will be called again, causing another redirect and so on.
Try moving this code out of begin entirely; perhaps, as Htbaa suggested, auto might be what you're looking for. The standard $c->detach case (in controller controller) is:
sub check_login :Local {
# do something
$c->detach('controller/login_successful') if($success);
# display error message
}
sub login_successful :Local {
# do something with the logged in user.
}
In this case, doing a $c->res->redirect('http://example.com/login_successful') should work perfectly as well. Hope that helps!

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.