I'm trying to use require multiple times in my code, but I can to run it once.
if ($value =~ "test") {
require "mycode1.pm"; # Execute perfect
}
if ($value =~ "code") {
require "mycode1.pm"; # Not execute
}
if ($value =~ "last") {
require "mycode1.pm"; # # Not execute
}
I don't understand why it doesn't run, could you please help me?
As you've been told in the comments, Perl keeps a record of which libraries have already been loaded, so require will only be called once for each file.
A couple of notes on your code.
The right-hand operand to the binding operator should be a match (m/.../), a substitution (s/.../.../) or a transliteration (tr/.../.../). You're using strings, which are silently converted to matches at runtime - but it's better to be more explicit.
$value =~ /test/
Given that the results of your three if tests are all the same, it's probably worth converting them into a single test.
if ($value =~ /test|code|last/) {
...
}
Related
I installed libsql-translator-perl on Ubuntu 15.04 and ran it with
sqlt -f SQLite -t MySql /tmp/test.sql /tmp/out.sql
test.sql contains only this:
CREATE TABLE X (id INTEGER);
It failed with
Use of uninitialized value $name in pattern match (m//) at /usr/share/perl5/SQL/Translator.pm line 610.
I looked at this file, it contains
sub load {
my $name = shift;
my #path;
push #path, "" if $name =~ /::/; # error here
The call stack shows that it was called with
SQL::Translator::load(undef, 'SQL::Translator::Producer')
from here
sub _load_sub {
my ($tool, #path) = #_;
my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
if ( my $module = load($module => #path) ) { # <<<<<<<
my $sub = "$module\::$func_name";
return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
}
return undef;
}
I don't know enough Perl to unpick this any further. Does anyone know what might be going on? Thanks.
The error message tells you that $name is undefined; it is set to the first argument, i.e. the value of $module in _load_sub, which is set to the second captured match in m/((.*)::)?(\w+)$/: everything in the value of $tool before the first occurrence of ::, if :: occurs, and undefined otherwise.
So $tool does not contain the string ::; the matching pattern accounts for this (by including the ? metacharacter), but the code in load doesn't. Looks like a bug in the code. The documentation lists several ways to report this or verify whether this has been reported or fixed before.
You can debug Perl code by running it with perl -d - see its manual.
The SQL::Translator parser for MySQL is called "MySQL", not "MySql".
sqlt -f SQLite -t MySQL /tmp/test.sql /tmp/out.sql
Running sqlt -l will give you a complete list of the parsers available.
But I certainly agree that the error message could be better. It's worth raising a bug against this.
I have been looking for a solution to my problem and Hashes seem to be the answer after reading several posts but I am unsure how to implement this for my requirement, can anyone suggest how or even a better option?
In my code the variable $host is being set from values in a database. I loop through these values changing the value of $host each time.
I want to discard some types of host names, and to determine which hosts to discard I read in a user-configurable file which holds the Perl regex for that exclude. i.e. the config file has a line
EXCLUDE=\d+DAT\d+,\d+INF\d+
I then want to build up the Perl regexp match (logical OR), i.e.
if ( $host =~ m/\d+DAT\d+/ || $host =~ m/\d+INF\d+/ ) {
# do something
}
At the moment my code is hard wired as in the above example, but how can I dynamically construct the Perl regex after reading in the config file?
I have read the config file into an array and will start from there. The code above needs to end up like this:
if ($exclude clause) {
# do something
}
This is how I set about achieving that reading from the array:
for ($i = 1; $i < #conf; $i++) {
$exclude_clause .= "$host =~/" . #conf[$i] . "/ || ";
}
$exclude_clause =~ s/ \|\| $//;
The problem is referencing $host within the $exclude_clause. My regex string is built OK apart from the $host.
I would suggest a different approach that doesn't require you to build up a big Regex string and then evaluate it. Instead, what about using the List::MoreUtils module's any function, which accepts a block of code, evaluates it for each member of a list, and returns true once the block returns true for at least one entry in the list. For example:
use List::MoreUtils qw{ any };
if ( any { $host =~ $_ } #conf ) {
# do something
}
In the code block passed to any, the temp variable $_ contains the current entry in the list. That way you can avoid constructing a Regex in the first place.
I think you should store the complete regex in the configuration file, but it can be be a set of comma separated alternatives if need be.
You would use the qr// construct to build the regex:
my $exc1 = "\d+DAT\d+"; # Read from configuration file
my $ecc2 = "\d+INF\d+";
my $rex1 = qr/$exc1/;
my $rex2 = qr/$exc2/;
...populate $host...
if ($host =~ $rex1 || $host =~ $rex2)
{
...exclude $host...
}
else
{
...include $host...
}
Alternatively, you can build a single regex:
my $exc1 = "\d+DAT\d+"; # Read from configuration file
my $ecc2 = "\d+INF\d+";
my $rex = qr/$exc1|$exc2/;
...populate $host...
if ($host =~ $rex)
{
...exclude $host...
}
else
{
...include $host...
}
The single regex can be built from as many alternative exclusionary regex fragments as you like. Of course, if the value in the file is:
EXCLUDE=\d+DAT\d+|\d+INF\d+
then your code simplifies once more, assuming the regex string is read into $exc:
my $exc = "\d+DAT\d+|\d+INF\d+"; # Read from file
my $rex = qr/$exc/;
...populate $host...
if ($host =~ $rex)
{
...exclude $host...
}
else
{
...include $host...
}
I'm trying to use perl Text::Template for short templates and so far failed to get it to iterate over an array.
Here is a short test program I wrote to demonstrate what I'm trying to do:
#!/usr/bin/perl
use Text::Template;
my $template = Text::Template->new(TYPE => 'STRING', SOURCE => <<'__EOT__');
array[0]: { $array[0] }
{ foreach my $i (#array) { }
{$i}
}
__EOT__
print $template->fill_in(HASH => { array => [qw(item1 item2)]});
According to the Text::Template manual I expected this to print:
array[0]: item1
item1
item2
But instead it prints
array[0]: item1
(i.e. the output of the first line outside the loop and an empty line).
I couldn't find anywhere on the web any example of someone actually using a loop inside a template, though the documentation says it should "just work".
What am I missing?
my $template = Text::Template->new(TYPE => 'STRING', SOURCE => <<'__EOT__', DELIMITERS => [qw(<% %>)],);
Pick different delimiters. The documentation advises you to do so several times for various reasons, mostly for being easier to work with because Perl code also uses {} braces. It also says:
Because the parsing of templates is simplified by the absence of backslash escapes, using alternative DELIMITERS may speed up the parsing process by 20-25%. This shows that my original choice of { and } was very bad.
Just {$i} does not work here because it is in void context. The documentation says:
The result of the last statement executed will be evaluted in scalar context; the result of this statement is a string, which is interpolated into the template in place of the program fragment itself.
Rewrite it with the $OUT variable:
<% foreach my $i (#array) {
$OUT .= $i
} %>
The documentation says:
Anything you append to this variable will appear in the output of the template. Also, if you use $OUT in a program fragment, the normal behavior, of replacing the fragment with its return value, is disabled; instead the fragment is replaced with the value of $OUT.
<% $OUT .= $_ for #array %>
Same result, but shorter.
A couple of experiments indicate that this:
{ stuff }
Is turned into (effectively) something like this pseudo-perl:
my $x = eval(stuff);
$template =~ s/{ stuff }/$x/;
So the "stuff" needs to be an expression so that it returns something to put into the template. Your "stuff" is a foreach loop which doesn't have a value so your template doesn't do anything interesting.
If you look at the tests for Text::Template (always go to the test suite for examples, the test suites for CPAN packages are invaluable for learning how things work), you'll see things like this:
{ $t = ''; foreach $n (1 .. 20) { $t .= $n . ' ' } $t }
Note the way $t is being used. That indicates that you want something more like this for your template:
array[0]: { $array[0] }
{ $t = ''; foreach my $i (#array) { $t .= "\t$i\n" } }
There's also the $OUT special variable which can take the place of $t above. The documentation for CPAN packages is generally pretty good and well worth reading, you'll miss it when you work in other languages.
Part of the specification says "Some names are special, e.g. Hughie, Dewey, Louis, and Donald. Other names may be added over the lifetime of the project at arbitrary times. Whenever you input one of those names, play quack.wav."
I could write ...
while (<>) {
if ($_ =~ /Hughie|Dewey|Louis/) {
quack() ;
}
elsif ($_ =~ /Donald/ {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
... but though untaxing to implement, it looks WTF-y: Where's the binary search? What if there were a sudden stupendous increase in the number of duck names? It would not scale at all!
I could create empty files using those names in a temporary directory, and then use the "file exists" API, but that seems roundabout, and I would have to be sure they were deleted at the end.
Surely there is a better way?
You could write that, but you should write this:
my %ducks = map {$_ => 1} qw(Hughie Dewey Louis);
while (<>) {
if ($ducks{$_}) {
quack() ;
}
elsif ($_ eq 'Donald') {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
Creating the hash takes a little bit of time, but not more than O(n). Lookup with a hash is O(1) though, so it is much more efficient than sequential search (via grep or a regex with alternation) assuming you will be checking for more than one or two items.
By the way, the regex that you have will match the words anywhere in the search string. You need to add start and end anchors if you want an exact match.
Alternatively, you could use smart matching
my #ducks = qw(Hughie Dewey Louis);
my $name = 'Dewey';
say 'smart match' if $name ~~ #ducks;
This is what is used by switch statements, so you could write
given ($name) {
when (#ducks) {
quack();
}
when ('Donald') {
quack();
you_re_fired_apprentice(); # Easter egg don't tell QA
}
}
As mentioned, hashes are the way to go for this. This is sort of what OOP looked like before OOP.
use strict;
use warnings;
my %duck_action = (
Donald => sub {quack(); you_re_fired_apprentice()},
Hughie => sub {quack()},
Dewie => sub {quack()},
Louis => sub {quack()},
);
for my $duck (qw( Hughie Dewie Donald Louis Porkie )) {
print "$duck: ";
my $action = $duck_action{$duck} || &no_such_duck;
$action->();
}
sub quack {
print "Quack!\n";
}
sub you_re_fired_apprentice {
print "You're fired!\n";
}
sub no_such_duck {
print "No such duck!\n";
}
You can use a Perl Hash. See also How can I represent sets in Perl? and Representing Sets in Perl.
Using hashes to implement a set is not exactly pretty, but it should be fast.
To find a string in a list, you could also use any in List::MoreUtils
use List::MoreUtils qw(any);
my #ducks = qw(Hughie Dewey Louis);
my $name = 'Dewey';
say 'any' if any {$name eq $_} #ducks;
If you're tied to using an array rather than a hash, you can use perl's grep function to search the array for a string.
#specialnames = qw(Hughie Dewey Louis);
while (my $value = <>) {
if (grep {$value eq $_}, #specialnames) {
quack() ;
}
elsif ($_ =~ /Donald/ {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
This does scale a lot worse than a hash, and might even scale worse than copying the array into a hash and then doing hash lookups.
EDIT:
I will try a better explication this time, this is the exact code from my script (sorry for all them coments, they are a result of your sugestions, and apear in the video below).
#use warnings;
#use Data::Dumper;
open(my $tmp_file, ">>", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#if( $id_client != "")
#allowed_locations = ();
#print $tmp_file "Before the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
if( $id_client )
{
# print $tmp_file "Start the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
# my $q = "select distinct id_location from locations inner join address using (id_db5_address) inner join zona_rural_detaliat using (id_city) where id_client=$id_client";
# my $st = &sql_special_transaction($sql_local_host, $sql_local_database, $sql_local_root, $sql_local_root_password, $q);
# print $tmp_file "Before the while loop: ref(st)='". ref($st) . "\n";
# while((my $id)=$st->fetchrow())
# {
# print $tmp_file "Row the while loop: ". Data::Dumper->Dump([$id]) . "";
# my $id = 12121212;
# push(#allowed_locations, $id);
# }
# print $tmp_file "After the while loop: ref(st)='". ref($st) . "\n";
# my($a) = 1;
#} else {
# my($a) = 0;
}
#print $tmp_file "After the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
close($tmp_file) or die "Can not close file: $!\n";
#&html_error(#allowed_locations);
First off all, somebody said that I should try to run it in command line, the script works fine in command line (no warnings, It was uncommented then), but when triyng to load in via apache in the browser it fails, please see this video where I captured the script behavior, what I tried to show in the video:
I have opened 2 tabs the first doesn't define the variable $id_client, the second defines the variable $id_client that is read from GET: ?id_client=36124 => $id_client = 36124; , both of them include the library in the video "locallib.pl"
When running the script with all the
new code commented the page loads
when uncoment the line that defines
the #allowed_locations = (); the
script fails
leave this definition and uncoment
the if block, and the definition of
my $a; in the if block; Now the script works fine when $id_client is
defined, but fails when $id_client
is not defined
Uncoment the else block and the
definition of my $a; in the else
block. Now the script works fine
with or without $id_client
now comment all the my $a;
definisions and comment the else
block, the script fails
but if I'm using open() to open
a file before the IF, and
close() to close it after the if it does't fail even if the IF block
is empty and event if there is no
else block
I have replicated all the steps when running the script in the command line, and the script worked after each step.
I know it sounds like something that cannot be the behavior of the script, but please watch the video (2 minutes), maybe you will notice something that I'm doing wrong there.
Using perl version:
[root#db]# perl -v
This is perl, v5.8.6 built for i386-linux-thread-mult
Somebody asked if I don't have a test server, answer: NO, my company has a production server that has multiple purposes, not only the web interface, and I cannot risk to update the kernel or the perl version, and cannot risk instaling any debuger, as the company owners say: "If it works, leave it alone", and for them the solution with my ($a); is perfect beacause it works, I'm asking here just for me, to learn more about perl, and to understand what is going wrong and what can I do better next time.
Thank you.
P.S. hope this new approach will restore some of my -1 :)
EDIT:
I had success starting the error logging, and found this in the error log after each step that resulted in a failure I got this messages:
[Thu Jul 15 14:29:19 2010] [error] locallib.pl did not return a true value at /var/www/html/rdsdb4/cgi-bin/clients/quicksearch.cgi line 2.
[Thu Jul 15 14:29:19 2010] [error] Premature end of script headers: quicksearch.cgi
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true. , a simple 1; statement at the end of the library ensures that (I put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
Don't know why in CLI it had no problem ...
Maybe I will get a lot of down votes now ( be gentle :) ) , but what can I do ...and I hope that some newbies will read this and learn something from my mistake.
Thank you all for your help.
You need to explicitly check for definedness.
If you want to enter the loop when $client is defined,
use if ( defined $client ).
If you want to enter the loop when $client is defined and a valid integer,
use if ( defined $client && $client =~ /^-?\d+$/ ).
I assume it's an integer from the context, if it can be a float, the regex needs to be enhanced - there's a standard Perl library containing pre-canned regexes, including ones to match floats. If you require a non-negative int, drop -? from regex's start.
If you want to enter the loop when $client is defined and a non-zero (and assuming it shouldn't ever be an empty string),
use if ( $client ).
If you want to enter the loop when $client is defined and a valid non-zero int,
use if ( $client && $client =~ /^-?\d+$/ ).
Your #ids is "undef" when if condition is false, which may break the code later on if it relies on #ids being an array. Since you didn't actually specify how the script breaks without an else, this is the most likely cause.
Please see if this version works (use whichever "if" condition from above you need, I picked the last one as it appears to match the closest witrh the original code's intent - only enter for non-zero integers):
UPDATED CODE WITH DEBUGGING
use Data::Dumper;
open(my $tmp_file, ">", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#ids = (); # Do this first so #ids is always an array, even for non-client!
print $tmp_file "Before the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
if ( $client && $client =~ /^-?\d+$/ ) # First expression catches undef and zero
{
print $tmp_file "Start the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
my $st = &sql_query("select id from table where client=$client");
print $tmp_file "Before the while loop: ref(st)='". ref($st) . "'\n";
while(my $row = $st->fetchrow())
{
print $tmp_file "Row the while loop: ". Data::Dumper->Dump([row]) . "'\n";
push(#ids, $row->[0]);
}
print $tmp_file "After the while loop: ref(st)='". ref($st) . "'\n";
# No need to undef since both variables are lexically in this block only
}
print $tmp_file "After the if\n";
close($tmp_file) or die "Can not close file: $!\n";
when checking against a string, == and != should be respectively 'eq' or 'ne'
if( $client != "" )
should be
if( $client ne "" )
Otherwise you don't get what you're expecting to get.
Always begin your script with :
use warnings;
use strict;
these will give you usefull informations.
Then you could write :
my #ids;
if (defined $client) {
#ids = (); # not necessary if you run this part only once
my $st = sql_query("select id from table where client=$client");
while( my ($id) = $st->fetchrow ) {
push #ids, $id;
}
} else {
warn '$client not defined';
}
if (#ids) { # Your query returned something
# do stuff with #ids
} else {
warn "client '$client' does not exist in database";
}
Note: this answer was deleted because I consider that this is not a real question. I am undeleting it to save other people repeating this.
Instead of
if( $client != "" )
try
if ($client)
Also, Perl debugging is easier if you
use warnings;
use strict;
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true, a simple 1; statement at the end of the library ensures that (put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
The conclusion:
I have learned that every time you write a library or modify one, ensure that it's last statment returns true;
Oh my... Try this as an example instead...
# Move the logic into a subroutine
# Forward definition so perl knows func exists
sub getClientIds($);
# Call subroutine to find id's - defined later.
my #ids_from_database = &getClientIds("Joe Smith");
# If sub returned an empty list () then variable will be false.
# Otherwise, print each ID we found.
if (#ids_from_database) {
foreach my $i (#ids_from_database) {
print "Found ID $i \n";
}
} else {
print "Found nothing! \n";
}
# This is the end of the "main" code - now we define the logic.
# Here's the real work
sub getClientIds($) {
my $client = shift #_; # assign first parameter to var $client
my #ids = (); # what we will return
# ensure we weren't called with &getClientIds("") or something...
if (not $client) {
print "I really need you to give me a parameter...\n";
return #ids;
}
# I'm assuming the query is string based, so probably need to put it
# inside \"quotes\"
my $st = &sql_query("select id from table where client=\"$client\"");
# Did sql_query() fail?
if (not $st) {
print "Oops someone made a problem in the SQL...\n";
return #ids;
}
my #result;
# Returns a list, so putting it in a list and then pulling the first element
# in two steps instead of one.
while (#result = $st->fetchrow()) {
push #ids, $result[0];
}
# Always a good idea to clean up once you're done.
$st->finish();
return #ids;
}
To your specific questions:
If you want to test if $client is defined, you want "if ( eval { defined $client; } )", but that's almost certainly NOT what you're looking for! It's far easier to ensure $client has some definition early in the program (e.g. $client = "";). Also note Kaklon's answer about the difference between ne and !=
if (X) { stuff } else { } is not valid perl. You could do: if (X) { stuff } else { 1; } but that's kind of begging the question, because the real issue is the test of the variable, not an else clause.
Sorry, no clue on that - I think the problem's elsewhere.
I also echo Kinopiko in recommending you add "use strict;" at the start of your program. That means that any $variable #that %you use has to be pre-defined as "my $varable; my #that; my %you;" It may seem like more work, but it's less work than trying to deal with undefined versus defined variables in code. It's a good habit to get into.
Note that my variables only live within the squiggliez in which they are defined (there's implicit squiggliez around the whole file:
my $x = 1;
if ($x == 1)
{
my $x = 2;
print "$x \n"; # prints 2. This is NOT the same $x as was set to 1 above.
}
print "$x \n"; # prints 1, because the $x in the squiggliez is gone.