In my frame constructor I have a function that easily makes a menu bar for me.
package Routines;
#This function will set up a menu
#REQUIRED: entries
#RETURNS: id, menu
sub SetupMenu {
$menuItemCount = 0; #Element number under the same menu
$subMenuCount = 0; #Number of menus
$mbar = Wx::MenuBar->new(); #Menu bar constructor
for ($totalCount = 0; $totalCount < scalar($_[1]); $totalCount++) { #Loop for each entry
if ($menuItemCount == 0) { #If this is the first entry in the menu
$menuList[$subMenuCount] = Wx::Menu->new($_[$totalCount]); #Construct a menu and make this the title
} elsif ($_[$totalCount] == "---") { #If the entry is ---
#Treat it as a separator, skip ID
} elsif ($_[$totalCount] == "***") { #If the entry is ***
$mbar->Append($menuList[$subMenuCount]); #Add the menu to the bar
$menuItemCount = 0; #Reset the number of elements
$subMenuCount++; #Increment the number of menus
} else { #On normal operation
$menuList[$subMenuCount]->Append($id[$totalCount], $_[$totalCount]); #Add the element to the menu and assign it an ID
}
}
#print $mbar;
return (#id, $mbar);
}
#This package puts crap in the main window
package mehFrame;
use base qw(Wx::Frame);
sub new {
#Preparation
$class = shift;
$self = $class->SUPER::new(#_);
#Place the panel
$pan = Wx::Panel->new($self, -1);
#Set up menus
(#mehId, $mehBar) = Routines::SetupMenu("File", "Open ROM", "Save ROM", "Save ROM As", "---", "Close ROM", "Exit");
#Return
return $self;
}
[...]
Unfortunately, it doesn't work. After putting in a print in the SetupMenu() function, it did not print. On the other hand, when I put it a warn, it warned.
What's worse is that even if I put in a print in the new() function, it still doesn't print. What is going on?
Yakov, I'll take a stab at this in the absence of other answers, but take this with a grain of salt since I'm not a wxPerl expert.
Your description sounds like printing to STDERR works, since that's where warn goes, whereas printing to STDOUT does not.
Try doing print STDERR $mbar instead - I'm fairly sure it will work.
UPDATE: As per daotoad's excellent suggestion, this could also be attributed to lack of flush - if so, then setting autoflush on STDOUT would solve it. Whether it's one or the other, depends on what the OP tries. I added it to my answer since daotoad only posted a comment and didn't add his own separate answer yet - I will remove once he does that.
print works under Wx sometimes async undless you add an "\n"
Related
I want to make a console and change the automatic completion function when I press tab but I want to differentiate between two cases:
If I press tab and the beginning of the command matches a list I supplied in an array, the auto complete will be according to this array.
If I press tab and the command isn't recognized from the list I supplied, I want the generic completion function to work, so t hat it will auto complete directories and file names in the current directory.
Is it possible?
Thanks a lot.
Edit: I'm trying to do it inside a perl script. I saw this example:
rl_attempted_completion_function
A reference to an alternative function to create matches.
The function is called with TEXT, LINE_BUFFER, START, and END. LINE_BUFFER is a current input buffer string. START and END are indices in LINE_BUFFER saying what the boundaries of TEXT are.
If this function exists and returns null list or undef, or if this variable is set to undef, then an internal function rl_complete() will call the value of $rl_completion_entry_function to generate matches, otherwise the array of strings returned will be used.
The default value of this variable is undef. You can use it as follows;
use Term::ReadLine;
...
my $term = new Term::ReadLine 'sample';
my $attribs = $term->Attribs;
...
sub sample_completion {
my ($text, $line, $start, $end) = #_;
# If first word then username completion, else filename completion
if (substr($line, 0, $start) =~ /^\s*$/) {
return $term->completion_matches($text,
$attribs->{'username_completion_function'});
} else {
return ();
}
}
...
$attribs->{attempted_completion_function} = \&sample_completion;
completion_matches(TEXT, ENTRY_FUNC)
What I want to do is that in case when tab is pressed it recognizes a substring from an array I provide, the auto completion will be from that array (if there are multiple matches it will give all of them like a regular unix console).
Otherwise, I want the auto completion to be file recognition.
The subroutine used internally by Term::ReadLine::Gnu to provide the default completion is filename_completion_function, which you can call directly from your custom subroutine:
use Term::ReadLine;
my $term = new Term::ReadLine 'MyTerm';
$term->Attribs->{'completion_entry_function'} = \&my_completion;
my $ans = $term->readline('How can I help you? ');
sub my_completion {
my ($text, $state) = #_;
if (my_test) {
return my_custom_stuff;
}
else {
return Term::ReadLine::Gnu->filename_completion_function($text, $state);
}
}
I am using a foreach to loop through links. Do I need a $mech->back(); to continue the loop or is that implicit.
Furthermore do I need a separate $mech2 object for nested for each loops?
The code I currently have gets stuck (it does not complete) and ends on the first page where td#tabcolor3 is not found.
foreach my $sector ($mech->selector('a.link2'))
{
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
$mech->back();
}
else
{
$mech->back();
}
}
You cannot access information from a page when it is no longer on display. However, the way foreach works is to build the list first before it is iterated through, so the code you have written should be fine.
There is no need for the call to back as the links are absolute. If you had used click then there must be a link in the page to click on, but with follow_link all you are doing is going to a new URL.
There is also no need to check the number of links to follow, as a for loop over an empty list will simply not be executed.
To make things clearer I suggest that you assign the results of selector to an array before the loop.
Like this
my #sectors = $mech->selector('a.link2');
for my $sector (#sectors) {
$mech->follow_link($sector);
my #places = $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->follow_link($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Update
My apologies. It seems that follow_link is finicky and needs to follow a link on the current page.
I suggest that you extract the href attribute from each link and use get instead of follow_link.
my #selectors = map $_->{href}, $mech->selector('a.link2');
for my $selector (#selectors) {
$mech->get($selector);
my #places = map $_->{href}, $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->get($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Please let me know whether this works on the site you are connecting to.
I recommend to use separate $mech object for this:
foreach my $sector ($mech->selector('a.link2'))
{
my $mech = $mech->clone();
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
my $mech = $mech->clone();
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
#$mech->back();
}
# else
# {
# $mech->back();
# }
}
I am using WWW:Mechanize::Firefox to loop over a bunch of URLs with loads of Javascript. The page does not render immediately so need test if a particular page element is visible (similar to suggestion in Mechanize::Firefox documentation except 2 xpaths in the test) before deciding next action.
The page eventually renders a xpath to 'no info' or some wanted stuff after about 2-3 seconds. If no info we go to next URL. I think there is some sort of race condition with both xpaths not existing at once causing the MozRepl::RemoteObject: TypeError: can't access dead object error intermittently (at the sleep 1 in the loop oddly enough).
My solution that seems to work/improve reliability is to enclose all the $mech->getand$mech->is_visible in an eval{}; like this:
eval{
$mech->get("$url");
$retries = 15; #test to see if element visible = page complete
while ($retries-- and ! $mech->is_visible( xpath => $xpath_btn ) and ! $mech->is_visible( xpath => $xpath_no_info )){
sleep 1;
};
last if($mech->is_visible( xpath => $xpath_no_info) ); #skip rest if no info page
};
Others might suggest improvements on this.
Hey so I am trying to make a simple 'dating website' however I'm struggling with CGI aspect :( Mainly I'm having trouble with forms(I think I'm not too sure what I'm struggling with).
I have this statement
print header, start_html("EngCupid"), h2("EngCupid"), start_form;
if (!param() || param("home")) {
show_welcome();
} elsif (param("browse")) {
browse_page();
} elsif (param("search")) {
search_users();
} elsif (param("username")) {
search_results();
} else {
print "fail";
}
print end_form, end_html;
exit 0;
To Handle the general navigation of the website. However, I'm struggling when it comes to submit buttons etc inside these functions. So my browse_page() function is
sub browse_page {
print h2("Browse Page");
print p;
if (param("next")) {
$hidden_variable = param("x") + 1;
}
param('x', $hidden_variable);
$hidden_variable = 0;
print hidden('x');
print submit("next", "Next");
print submit("home", "Home"), " ", submit("search", "Search Users");
}
Which is supposed to increment a variable that I need to use for further functions every time I press the next key. However, whenever I press the next key it just prints fail as in the form isn't being passed?
Do I need a new form inside each function I am printing? I tried it but it still didn't work. Just a little lost in forms in general.
I am not sure what you are trying to achieve. Maybe the problem is that the x is not being sent back from client to server, maybe you wanted
print hidden('x', param('x'));
Also, why do you set $hidden_variable to 0? After submitting, the script will run again, the old value of the variable will not be accessible anymore.
So I have two files, one that contains my text, and another which I want to contain filter words. The one shown here is supposed to be the one with the curse words. Basically, what I'm doing is iterating through each of the words in the text file, and trying to compare them against the curse words.
sub filter {
$word_to_check = $_;
open ( FILE2, $ARGV[1]) || die "Something went wrong. \n";
while(<FILE2>) {
#cursewords = split;
foreach $curse (#cursewords) {
print $curse."\n";
if($word_to_check eq $curse) { return "BAD!";}
}
}
close ( FILE2 );
}
Here are the "curse words":
what is
Here is the text file:
hey dude what is up
But here's what's going wrong. As you can see, I've put a print statement to see if the curse words are getting checked correctly.
hey what
is
dude what
is
what what
is
is what
is
up what
is
I literally have no idea why this could be happening. Please let me know if I should post more code.
EDIT:
AHA! thanks evil otto. It seems I was getting confused with another print statement I had put in before. Now the problem remains: I think I'm not checking for string equality correctly. Here's where filter is getting called:
foreach $w( #text_file_words )
{
if(filter($w) eq "BAD!")
{
#do something here
}
else { print "good!"; }
}
EDIT 2: Nevermind, more stupidity on my part. I need to get some sleep, thanks evil otto.
change
$word_to_check = $_;
to
$word_to_check = shift;
You needed to collect arguments as an array in perl...
sub myFunction{
($wordToCheck) = #_; #this is the arg array, if you have more than one arg you just separate what's between the parenthesis with commas.
}
Here's what I'd like to achieve:
sub first {
print "this is original first";
}
*original_first = \&first;
sub first {
print "this is first redefined";
}
original_first(); # i expect this to print "this is original first"
first() # i expect this to print "this is first redefined"
I thought that by saving the symbol for first, I'd be able to later call the original subroutine ( under the name original_first ) and to also be able to call first, and get the one redefined. However, if I call the original_first, I still get the "this is first redefined". What do I have to do to make this work?
This should work as you expect:
sub first {
print "this is original first";
}
*original_first = \&first;
*first = sub {
print "this is first redefined";
};
in your code, Perl interprets both sub declarations similar to this:
BEGIN {
*first = sub { ... }
}
so both assignments to &first end up happening before saving the copy and calling the routines. the fix is to make the second declaration into a runtime assignment:
sub first {
print "this is original first";
}
*original_first = \&first;
*first = sub {print "this is first redefined"};
original_first(); # prints "this is original first"
first(); # prints "this is first redefined"
See the Hook::LexWrap module, which can handle all of that for you. If you don't want to use the module, just look at the source, which shows you exactly how to do it.