Please help me debug SQL::Translator - perl

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.

Related

perl - system command arguments give error

Tried hard to find a solution for this. But I probably need some help. I am trying to pass a bunch of arguments in system command in perl. But I get an irrelevant error. I have my variables correctly declared with the right scope and still get this error below. Here is my code.
#!/usr/bin/perl
use warnings;
use strict;
my $mi = 0;
my $mj = 0;
my #regbyte;
my #databyte;
my $filename;
my #args;
#regbyte = ("00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F","10","11","12");
#databyte = ("00","01","02","03","04","05","06","07","08","09", "0A", "0B");
for($mi=0; $mi<13; $mi++)
{
for($mj=0; $mj<256; $mj++)
{
$filename = "write_" . $regbyte[$mi] . "_" . $databyte[$mj] . ".atp";
system("perl perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");
}
}
This is the error message I get.
Global symbol "$databyte" requires explicit package name at perl_2_ver2.8.pl line 20.
Execution of perl_2_ver2.8.pl aborted due to compilation errors.
I'm puzzled about a few things, in particular the trailing "n" you have in your system call. Is that supposed to be "\n"? Because it's unnecessary and wrong in that context.
The main problem is that you have
for ( $mj = 0; $mj < 256; $mj++ ) { .. }
and then access $databyte[$mj] when #databyte has only twelve elements. It's hard to know what you might mean.
Here's how I would write something that works, but may not be your intention.
use strict;
use warnings 'FATAL';
for my $regbyte (0 .. 0x12) {
for my $databyte (0 .. 0x0B) {
my $filename = sprintf "write_%02X_%02X.atp", $regbyte, $databyte;
system("perl perl_2_ver2.5.pl $filename $regbyte $databyte");
}
}
It looks like you want to run your script perl_2_ver2.5.pl with input consisting of all files that look like write_*_*.atp. Is that right?
Unless the directory contains atp files that you don't want to process, you are probably better off using just
while (my $filename = glob 'write*.atp') {
next unless /\Awrite_(\p{hex}{2})_(\p{hex}{2}).atp\z/;
system("perl perl_2_ver2.5.pl $filename $1 $2");
}
which just processes all the files that do exist and match the pattern.
I copy/pasted your code and only replaced the program parameter for the system call and I do not get the error you are reporting. However there are many array elements accessed, that don't exist.
You can limit your loops using the arraysizes like this:
for($mi=0; $mi<$#regbyte; $mi++)
And I believe you have two alternatives for your system call, either perl_2_ver2.5.pl is executable, then you can say (supposed, same directory):
system("./perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");
Or you have to call:
system("perl" , "./perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");

Perl Plucene Index Search

Fooling around more with the Perl Plucene module and, having created my index, I am now trying to search it and return results.
My code to create the index is here...chances are you can skip this and read on:
#usr/bin/perl
use Plucene::Document;
use Plucene::Document::Field;
use Plucene::Index::Writer;
use Plucene::Analysis::SimpleAnalyzer;
use Plucene::Search::HitCollector;
use Plucene::Search::IndexSearcher;
use Plucene::QueryParser;
use Try::Tiny;
my $content = $ARGV[0];
my $doc = Plucene::Document->new;
my $i=0;
$doc->add(Plucene::Document::Field->Text(content => $content));
my $analyzer = Plucene::Analysis::SimpleAnalyzer->new();
if (!(-d "solutions" )) {
$i = 1;
}
if ($i)
{
my $writer = Plucene::Index::Writer->new("solutions", $analyzer, 1); #Third param is 1 if creating new index, 0 if adding to existing
$writer->add_document($doc);
my $doc_count = $writer->doc_count;
undef $writer; # close
}
else
{
my $writer = Plucene::Index::Writer->new("solutions", $analyzer, 0);
$writer->add_document($doc);
my $doc_count = $writer->doc_count;
undef $writer; # close
}
It creates a folder called "solutions" and various files to it...I'm assuming indexed files for the doc I created. Now I'd like to search my index...but I'm not coming up with anything. Here is my attempt, guided by the Plucene::Simple examples of CPAN. This is after I ran the above with the param "lol" from the command line.
#usr/bin/perl
use Plucene::Simple;
my $plucy = Plucene::Simple->open("solutions");
my #ids = $plucy->search("content : lol");
foreach(#ids)
{
print $_;
}
Nothing is printed, sadly )-=. I feel like querying the index should be simple, but perhaps my own stupidity is limiting my ability to do this.
Three things I discovered in time:
Plucene is a grossly inefficient proof-of-concept and the Java implementation of Lucene is BY FAR the way to go if you are going to use this tool. Here is some proof: http://www.kinosearch.com/kinosearch/benchmarks.html
Lucy is a superior choice that does the same thing and has more documentation and community (as per the comment on the question).
How to do what I asked in this problem.
I will share two scripts - one to import a file into a new Plucene index and one to search through that index and retrieve it. A truly working example of Plucene...can't really find it easily on the Internet. Also, I had tremendous trouble CPAN-ing these modules...so I ended up going to the CPAN site (just Google), getting the tar's and putting them in my Perl lib (I'm on Strawberry Perl, Windows 7) myself, however haphazard. Then I would try to run them and CPAN all the dependencies that it cried for. This is a sloppy way to do things...but it's how I did them and now it works.
#usr/bin/perl
use strict;
use warnings;
use Plucene::Simple;
my $content_1 = $ARGV[0];
my $content_2 = $ARGV[1];
my %documents;
%documents = (
"".$content_2 => {
content => $content_1
}
);
print $content_1;
my $index = Plucene::Simple->open( "solutions" );
for my $id (keys %documents)
{
$index->add($id => $documents{$id});
}
$index->optimize;
So what does this do...you call the script with two command line arguments of your choosing - it creates a key-value pair of the form "second argument" => "first argument". Think of this like the XMLs in the tutorial at the apache site (http://lucene.apache.org/solr/api/doc-files/tutorial.html). The second argument is the field name.
Anywho, this will make a folder in the directory the script was run in - in that folder will be files made by lucene - THIS IS YOUR INDEX!! All we need to do now is search that index using the power of Lucene, something made easy by Plucene. The script is the following:
#usr/bin/perl
use strict;
use warnings;
use Plucene::Simple;
my $content_1 = $ARGV[0];
my $index = Plucene::Simple->open( "solutions" );
my (#ids, $error);
my $query = $content_1;
#ids = $index->search($query);
foreach(#ids)
{
print $_."---seperator---";
}
You run this script by calling it from the command line with ONE argument - for example's sake let it be the same first argument as you called the previous script. If you do that you will see that it prints your second argument from the example before! So you have retrieved that value! And given that you have other key-value pairs with the same value, this will print those too! With "---seperator---" between them!

Controlling arguments in perl with Getopt::Long

I am trying to use Getopt::Long add command line arguments to my script (seen below). The problem I am running into is related to multiple commands that do different things. For example I have an option flag that sets the configuration file to use with the script the option is -c [config_path] and I also have -h for help.
The problem I am running into is I need to have a condition that states whether or not the config option has been used AND a config file has been specified. I tried counting the options in #ARGV but found if -h and -c are specifed it causes the script to move on the to the subroutine load_config anyway. Because as seen in the code below when 2 arguments are found in #ARGV it fires the subroutine.
In what way could I fix this? At least in my head specifying -h and -c at the same time sorta contradicts each other. Is there a way to make it so only "informational commands" like help cannot be executed with "operational commands" like -c? Heck is there a way where I get a list of the commands that have been passed? I tried printing the contents of #ARGV but nothing was in it even though I had specified command arguments.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Term::ANSIColor;
use XML::Simple;
use Net::Ping;
use Net::OpenSSH;
use Data::Dumper;
# Create a new hash to copy XML::Simple configuration file data into
my %config_file;
# Clear the screen and diplay version information
system ("clear");
print "Solignis's Backup script v0.8 for ESX\\ESX(i) 4.0+\n";
print "Type -h or --help for options\n\n";
# Create a new XML::Simple object
my $xml_obj = XML::Simple->new();
# Create a new Net::Ping object
my $ping_obj = Net::Ping->new();
my $config_file;
my $argcnt = $#ARGV + 1;
GetOptions('h|help' => \&help,
'c|config=s' => \$config_file
);
if ($argcnt == 0) {
print "You must supply a config to be used\n";
} elsif ($argcnt == 2) {
if (! -e $config_file) {
print color 'red';
print "Configuration file not found!\n";
print color 'reset';
print "\n";
die "Script Halted\n";
} else {
load_config();
}
}
sub load_config {
print color 'green';
print "$config_file loaded\n";
print color 'reset';
my $xml_file = $xml_obj->XMLin("$config_file",
SuppressEmpty => 1);
foreach my $key (keys %$xml_file) {
$config_file{$key} = $xml_file->{$key};
}
print Dumper (\%config_file);
}
sub help {
print "Usage: backup.pl -c [config file]\n";
}
#ARGV is altered by GetOptions, that is why it seems empty. Rather than counting arguments, just directly check if $config_file is defined.
BTW, IMO there is no need to try to exclude -c from being used with -h. Normally a "help" just prints the help text and exits without taking any other action, check that first and it shouldn't matter whether -c is supplied or not.
Something like
my $help;
my $config_file;
GetOptions('h|help' => \$help,
'c|config=s' => \$config_file
);
if ( defined $help ) {
help();
} elsif ( defined $config_file ) {
...;
} else {
die "No arguments!";
}
You might also want to check out Getopt::Euclid which presents some expanded ways to provide options and a cool way of using the programs documentation as the spec for the command-line arguments.
You can always set a default value for the options eg my $help = 0; my $config_file = ""; and then test for those values.

just can't get perl working as expected ( conditionals and variable declaring )

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.

Why does my Perl script complain about 'Global symbol "$connection" requires explicit package name'?

my $now = &GetDate;
my $myHeader = &ReadMessage;
my $mySoftwareVersions = param('mySoftwareVersions');
my $q = new CGI;print $q->header();
use CGI::Carp(fatalsToBrowser);
getAllSoftwareVersions();
sub getAllSoftwareVersions
{
my $user = "zxxx";
my $passwd = "xxxx";
# my $tableName = "config_table";
# my $connection = DBI->connect("DBI:mysql:MESCI:hamysql02.stl.mo.boeing.com:18080", $user, $passwd, { AutoCommit => 0, RaiseError => 1}) or die "Couldn't connect to Database: " . DBI->errstr;
print "Must be connected\n\n";
print "\n\n";
# Error here.
my #Rows = &getConfigTableRows($connection, $config_table, $mySoftwareVersions );
my $total = #Rows;
print "total is ";
print $total;
The Above code dies with:
Global symbol "$connection" requires explicit package name
Edit
This question is related to :
https://stackoverflow.com/questions/682695/how-do-i-resolve
https://stackoverflow.com/questions/681557/xml-cannot-be-displayed-error-from-perl-cgi-script-using-mysql
Hopefully the original poster will be able to clean this up so it makes more sense, but here's what we've got so far so we can attempt to help.
Although Kent's answer is thinking ahead, the error is simply telling you that you did not declare $connection as a lexical ( "my" ) variable. So therefore, perl interprets it as that you must be referring to a package global.
Raw Perl does not complain when you use an undefined variable, it considers it a package global. You appear to have strict on somewhere (a standard and recommended practice), which wants you to declare your variables before using them. If you didn't declare the variable in the current package (or "namespace"), it assumes you're referring to a variable declared in another package, so it asks you to append the package name, just to keep everything clear and aboveboard.
Perl uses my to declare scoped variables, and our to declare package globals.
my $connection = "Rainbow";
OR
our $connection = 'French';
Just in case you got the wrong idea, the error message would go away if you turned strict off, your problem wouldn't. And they might go underground.
{ no strict;
my #rows = getConfigTableRows( $nothing, #other_stuff );
}
Perl just won't complain that $nothing is nothing. And this easy-to-fix error could cause subtler errors in other places. Plus think if you had assigned $connection successfully, only to type:
{ no strict;
my #rows = getConfigTableRows( $connecion, $config_table, $mySoftwareVersions );
}
Perl gives you a message about '$connecion' and hopefully, you can tell that it was a typo, and forgo at least 30 minutes not seeing it and wondering if your query is wrong, or whatever.
Well, if this is the related content for this other question,
The reason this is erroring is because you have commented out the line that creates the connection variable.
How are you going to query the database for a table row when you don't have the database connection defined?
Re:
my $now = &GetDate;
my $myHeader = &ReadMessage;
If you are going to use & on your function calls, make sure you use parentheses too:
my $now = &GetDate();
my $myHeader = &ReadMessage();
Otherwise, the currently executing sub's parameters are made available to (and alterable by) the subroutine you are calling.
This means that if you use your cgi script under mod_perl, suddenly you are in effect doing
my $now = &GetDate( Apache2::RequestUtil->request );
which is likely to be very wrong if GetDate takes an optional argument.