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.
Related
I am getting a warning as:
Use of uninitialized value in numeric eq (==) at script.pl line 53; line 53 isif statement`
My code snippet:
foreach(#array)
{
push #gene2refseq, $_;
}
foreach(#::ids)
{
if($_ == $gene2refseq[1])
{
push #::prot_gi, $gene2refseq[6];
}
}
Now if I declare $gene2refseq[1] before foreach(#::ids) the same error persists; but if I initialize it before foreach(#::ids) viz. $gene2refseq[1] = 0 it didn't give the error but also no results; as the value is initialized to 0.
I think I am initializing it at a wrong place, but then where have I to initialize it? As I can't initialize it before or in foreach(#array)
Disclaimer: I am not very good with use warnings and use strict
Edit: Solved
Thanks for the help; I just declared the #gene2refseq and initialized $gene2refseq[1] = 0 before the foreach(#array), and it worked fine.
Also thanks for correcting me on foreach usage.
A question:
What if I have to access multiple indexes of an array? Do I have to initialize them all? As here I need to access only a single index, so I initialized it.
If #gene2refeq is empty and #array is empty before the start of that code snippet, then #gene2refeq will be empty by line 53.
To find out, print the contents of #array and #gene2refeq. It's also possible #::ids contains uninitialized values, check that too. Add a separator so you can see what's in them.
print "\#array is ".join(", ", #array)."\n";
print "\#gene2refeq is ".join(", ", #gene2refeq)."\n";
print "\#::ids is ".join(", ", #::ids)."\n";
As to your question about when to initialize things, there's a difference between declaring a variable and initializing it. my and our declare a variable to exist lexically and globally respectively. Then you can populate (initialize) it.
The basic pattern of your program might look something like this.
my #ids;
...code to populate #ids...
my #gene2refeq;
...code to populate #gene2refeq...
my #array;
...code to populate #array...
push #gene2refeq, #array;
die "\#gene2refeq is not long enough, ".join(", ", #gene2refeq)
unless #gene2refeq >= 7;
my #prot_gi;
foreach my $id (#ids) {
if($id == $gene2refseq[1])
{
push #prot_gi, $gene2refseq[6];
}
}
A few other points. That first foreach loop is better written as simply...
push #gene2refseq, #array;
Using #::ids and #::prot_gi is odd. That's shorthand for getting the global variable #ids in the main package. It shouldn't be necessary and smells like cargo culting.
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.
}
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"
I have a Perl routine that manages error checking. There are about 10 different checks and some are nested, based on prior success. These are typically not exceptional cases where I would need to croak/die. Also, once an error occurs, there's no point in running through the rest of the checks.
However, I can't seem to think of a neat way to solve this issue except by using something analogous to the following horrid hack:
sub lots_of_checks
{
if(failcond)
{
goto failstate:
}
elsif(failcond2)
{
goto failstate;
}
#This continues on and on until...
return 1; #O happy day!
failstate:
return 0; #Dead...
}
What I would prefer to be able to do would be something like so:
do
{
if(failcond)
{
last;
}
#...
};
An empty return statement is a better way of returning false from a Perl sub than returning 0. The latter value will actually be true in list context:
sub lots_of_checks {
return if fail_condition_1;
return if fail_condition_2;
# ...
return 1;
}
Perhaps you want to have a look at the following articles about exception handling in perl5:
perl.com: Object Oriented Exception Handling in Perl
perlfoundation.com: Exception Handling in Perl
You absolutely can do what you prefer.
Check: {
last Check
if failcond1;
last Check
if failcond2;
success();
}
Why would you not use exceptions? Any case where the normal flow of the code should not be followed is an exception. Using "return" or "goto" is really the same thing, just more "not what you want".
(What you really want are continuations, which "return", "goto", "last", and "throw" are all special cases of. While Perl does not have full continuations, we do have escape continuations; see http://metacpan.org/pod/Continuation::Escape)
In your code example, you write:
do
{
if(failcond)
{
last;
}
#...
};
This is probably the same as:
eval {
if(failcond){
die 'failcond';
}
}
If you want to be tricky and ignore other exceptions:
my $magic = [];
eval {
if(failcond){
die $magic;
}
}
if ($# != $magic) {
die; # rethrow
}
Or, you can use the Continuation::Escape module mentioned above. But
there is no reason to ignore exceptions; it is perfectly acceptable
to use them this way.
Given your example, I'd write it this way:
sub lots_of_checks {
local $_ = shift; # You can use 'my' here in 5.10+
return if /condition1/;
return if /condition2/;
# etc.
return 1;
}
Note the bare return instead of return 0. This is usually better because it respects context; the value will be undef in scalar context and () (the empty list) in list context.
If you want to hold to a single-exit point (which is slightly un-Perlish), you can do it without resorting to goto. As the documentation for last states:
... a block by itself is semantically identical to a loop that executes once.
Thus "last" can be used to effect an early exit out of such a block.
sub lots_of_checks {
local $_ = shift;
my $all_clear;
{
last if /condition1/;
last if /condition2/;
# ...
$all_clear = 1; # only set if all checks pass
}
return unless $all_clear;
return 1;
}
If you want to keep your single in/single out structure, you can modify the other suggestions slightly to get:
sub lots_of_checks
{
goto failstate if failcond1;
goto failstate if failcond2;
# This continues on and on until...
return 1; # O happy day!
failstate:
# Any clean up code here.
return; # Dead...
}
IMO, Perl's use of the statement modifier form "return if EXPR" makes guard clauses more readable than they are in C. When you first see the line, you know that you have a guard clause. This feature is often denigrated, but in this case I am quite fond of it.
Using the goto with the statement modifier retains the clarity, and reduces clutter, while it preserves your single exit code style. I've used this form when I had complex clean up to do after failing validation for a routine.