perl DBI memory leak - perl

I'm having some memory leak issues in a perl script that I'm running for extended periods of time, where the amount of memory that perl is taking up just continues to grow. Because of this, I am trying to use Devel::Leak to track down the leak. I discovered that whenever I call DBI's prepare method, the number of scalar values returned by Devel::Leak goes up by one. Below is I test script I've put together that does what I'm describing:
#!/usr/bin/perl
use strict;
use Devel::Leak;
use DBI;
START:
my $handle; # apparently this doesn't need to be anything at all
my $leaveCount = 0;
my $enterCount = Devel::Leak::NoteSV($handle);
print "ENTER: $enterCount SVs\n";
{
# CONFIG VARIABLES
my $platform = "mysql";
my $database = "db";
my $host = "localhost";
my $port = "3306";
my $user = "user";
my $pw = "pass";
#DATA SOURCE NAME
my $dsn = "dbi:mysql:$database:$host:3306";
# PERL DBI CONNECT
my $dbh = DBI->connect($dsn, $user, $pw);
$dbh->prepare("SELECT * FROM table"); # The script seems to gain one SV without this
# line here, but since this is my issue in my
# main script I decided to leave it in
# undef $dbh; I tried undef-ing this, but it made no difference
}
$leaveCount = Devel::Leak::CheckSV($handle);
print "\nLEAVE: $leaveCount SVs\n";
sleep(1);
goto START;
So is there something I'm doing wrong here, or is this a memory leak in the DBI module? Also, I know that adding one SV every time around the loop isn't a huge deal, and that I most likely have larger memory leaks elsewhere that are causing perl to take so much of the server's memory. However, I'd still like to fix this if I could. Coder's curiosity :)
UPDATE:
The first time through it seems to add about 3,000 SV's, and then every time after that it goes up 1 at a time.

There is a instance of DBI::dr (a blessed hash) living at $DBI::lasth. Check out the ChildHandles key.
#!/usr/bin/perl
use strict;
use warnings;
use Devel::Leak;
use Data::Dumper;
use Symbol::Table;
use DBI;
START:
{
my $handle;
my $enterCount = Devel::Leak::NoteSV($handle);
DB:
{
my $platform = "mysql";
my $database = "db";
my $host = "localhost";
my $port = "3306";
my $user = "user";
my $pw = "pass";
my $dsn = "dbi:mysql:$database:$host:3306";
my $dbh = DBI->connect( $dsn, $user, $pw );
$dbh->prepare("SELECT * FROM table");
$dbh->disconnect();
}
my $st = Symbol::Table->New( 'SCALAR', 'DBI' );
for my $subpkg ( keys %{ $st } ) {
my $val;
{
my $var = "DBI::${subpkg}";
no strict 'refs';
$val = ${$var};
}
print "scalar '$subpkg' => '$val'\n";
}
print Dumper( $DBI::lasth );
$DBI::lasth->{ChildHandles} = []; # <-- reset leaking data structure
my $leaveCount = Devel::Leak::CheckSV($handle);
print "\nCOUNT: $enterCount to $leaveCount SVs\n";
sleep(1);
redo START;
}

Related

Argon2 encryption in perl

I'm making simple perl script for sign up/login with Argon2 for encryption. (The credentials are taken from HTML Forms). The creation of users works fine , username and hashed password are stored in the database. The problem comes with the extraction/authentication. I'm not sure I'm using the verification properly.
#!/usr/bin/perl
use strict;
use warnings;
use Crypt::Argon2 qw/argon2id_pass argon2id_verify/;
use CGI::Simple;
use DBI;
sub get_data{
my ( $user) = #_;
my $statement = "SELECT USER_HASH FROM LOGIN_DATA WHERE USER_NAME = ?";
my $driver = "mysql";
my $database = "USERS";
my $dsn = "DBI:$driver:database=$database";
my $dataUsr = "user";
my $dataPass = "user123";
my $dbcon = DBI->connect($dsn,$dataUsr,$dataPass) or die $!;
my $preState = $dbcon->prepare($statement);
$preState->execute($user);
my #row ;
my $hash_pass;
while(#row=$preState->fetchrow_array()){
$hash_pass = $row[0];
}
return $hash_pass;
}
sub check_pass{
my ($user , $pass) = #_;
my $encoded = get_data($user);
return argon2id_verify($encoded , $pass);
}
my $cgi = CGI::Simple->new;
my $username = $cgi->param("username");
my $password = $cgi->param ("password");
check_pass($username , $password)
This are the erors when i try to run in in the terminal Use of uninitialized value in subroutine entry at checkUser.cgi line 30. Could not verify argon2id tag: Decoding failed at checkUser.cgi line 30.
Removing all the CGI, all the database connectivity and replacing the input with dummy values shows the same error message, so my guess is that you are not getting a result from the database:
#!/usr/bin/perl
use strict;
use warnings;
use Crypt::Argon2 qw/argon2id_pass argon2id_verify/;
sub check_pass{
my ($user , $pass) = #_;
return argon2id_verify(undef, $pass);
}
check_pass("mytest", "some-test-password-2018")
__END__
Use of uninitialized value in subroutine entry at tmp.pl line 7.
Could not verify argon2id tag: Decoding failed at tmp.pl line 7.
So the best step would be for you to isolate the problem by verifying that you actually get a result from the database.

inserting expect into perl loop

I have the following script that runs a command and puts the data in a DB. I need to account for the possibility of being asked for a password "password:" some of the time. How do I wrap an expect call into this?
#!/usr/software/bin/perl
use strict;
use DatabaseLib;
use Data::Dumper;
use Expect;
#Connect to database
my $dbh = DBI->connect($DB_CONNECT_STRING, $DB_USER, $DB_PASSWORD, { RaiseError => 1, AutoCommit => 1 })
or die "failed to connect to database: $DB_CONNECT_STRING";
my $expect = Expect->new;
my %burtHash;
my #cols = qw/date_create sub_by impact date-lastmod lastmod-by bug_rel case_score state s p type subtype subteam found_by target_release/;
my #burtInfo = `mycommand`;
my $timeout = 20;
my $password = "password";
while(my $ele = shift(#burtInfo)){
my ($index, #data) = split(/\s+/, $ele);
for my $i(0 .. $#cols){
$burtHash{$index}->{$cols[$i]} = shift(#data);
}
for my $id (keys %burtHash){
my %burt_details;
for my $col (keys %{$burtHash{$id}} ) {
$burt_details{$col} = $burtHash{$id}->{$col};
}
if ( $id =~ /\d+/) {
burt_update(
$dbh,
$id ,
\%burt_details,
);
}
}
}
I think I just need to put in something like this and call it, but i'm not sure where/how:
$expect->expect($timeout,
[ qr/password:/i, #/
sub {
my $self = shift;
$self->send("$password\n");
exp_continue;
}
]);
You're not using $expect anywhere there. You have to run your command via $expect->spawn so that your Expect object can handle things. And then you'll need some way of gathering its output (I'm thinking using $expect->log_file(...) to set the log to a string filehandle or something).
Once you're using $expect->spawn, then you can insert your password check. But there's no way you can do this with qx (the backticks).

Perl module, inhereting from DBI , "Can't call method 'prepare'" error [duplicate]

This question already has an answer here:
Closed 10 years ago.
Possible Duplicate:
Perl + POO and “Can't call method ”prepare"
I learned poo and i got to play with perl, create this module but when I call the segudno method I skip the following error 'Use of uninitialized value $database in concatenation ( .) ... ' Followed by 'Can't call method 'prepare' mm i don't really understand, any suggestions?
#!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::mysql;
package MysqlTest;
sub new{
my $class = shift;
my $query={};
bless($query, $class);
}
sub conexion{
my $self=shift;
my($database, $hostname, $user, $pwd)=#_;
$self->{"host"}=$hostname;
$self->{"database"}=$database;
$self->{"user"}=$user;
$self->{"pass"}=$pwd;
our $connect = DBI->connect("DBI:mysql:database=$database;host=$hostname;", $user, $pwd) or die $DBI::errstr;
my $mysqlopen = 1;
return;
}
sub consulta{
my $self=shift;
if (!my $mysqlopen) { &conexion(); }
my $id = "SELECT * FROM save_bookmarks WHERE id='123'";
our $result = my $connect->prepare($id);
$result->execute();
my #resultado = $result->fetchrow_array();
print "#resultado\n";
return;
}
sub datos{
my $self=shift;
print "::DATOS DE ACCESO::\n";
while ((my $key, my $value)=each(%$self)){
print "$key => $value\n";
}
}
1;
in other file for call msg and created objected.
#!/usr/bin/perl
use MysqlTest;
use warnings;
use strict;
my $mysqltest = MysqlTest->new();
$mysqltest->conexion("bookmarks", "localhost", "root", "pass");
$mysqltest->consulta();
this output in console.
Use of uninitialized value $database in concatenation (.) or string at MysqlTest.pm line 23.
Use of uninitialized value $hostname in concatenation (.) or string at MysqlTest.pm line 23.
Can't call method "prepare" on an undefined value at MysqlTest.pm line 31.
any idea?
thanks.
Your code includes this line:
if (!my $mysqlopen) { &conexion(); }
You call your conexion sub with no arguments. However, this sub expects several arguments, including a blessed object, that you don't provide. You might want to fix that. $database and $hostname also are expected in the arguments.
Your call to conexion will always be executed, because my $var creates a new variable and initializes it with undef—and the negation of undef is a true value.
Then you have this statement:
our $result = my $connect->prepare($id);
my creates a new variable $connect on which you try to call the method prepare. This doesn't work, as the created variable is no blessed reference but simply undef.
Scope in Perl
Here is a verbose example on how lexical scope with my works in Perl
# $var doesn't exist
sub foo {
# $var doesn't exist
my $var;
# $var exists
bar();
# $var exists
}
# $var doesn't exist
sub bar {
# $var doesn't exist
return;
}
# $var doesn't exist
You define a my variable mysqlopen in conexion, then redefine it in consulta. It is, however, not the same variable, as these variables reside in different scope.
Instead, you are likely to add fields mysqlopen and connect in the object you are passing around, as this is object data. You can then use this information just like the host or database fields.
Also, do not call the method conexion without an object. Objects are usually created with new.
Edit
It is quite difficult for me to debug your code and parse your English at the same time, so here is your code with the worst bugs removed. However, I have no experience with DBI, so it may not work directly:
sub conexion{
my $self=shift;
die "I need args!" unless #_;
my($database, $hostname, $user, $pwd)=#_;
$self->{host} = $hostname;
$self->{database} = $database;
$self->{user} = $user;
$self->{pass} = $pwd;
$self->{connect} = DBI->connect(
"DBI:mysql:database=$database;host=$hostname;",
$user,
$pwd,
) or die $DBI::errstr;
$self->{mysqlopen}= 1;
return;
}
sub consulta{
my $self = shift;
if (not $self->{mysqlopen}) {
die "This object wants to be conexioned before you consulta anything";
# you could also do
# $self->conexion(DEFAULT_VALUES);
# but then you would really *have* to provide defaults!
}
my $id = "SELECT * FROM save_bookmarks WHERE id='123'";
my $result = $self->{connect}->prepare($id);
$result->execute();
my #resultado = $result->fetchrow_array();
print "#resultado\n";
return;
}

How to return a hash from a module perl

Ok so this question has been bothering me for some time. I'm running a module that connects to a database and returns values from a query. I have a script calling the module and attempting to return the value from the subroutine of the module. But since code is better than words here's what I have:
sub selectCustomerName ($code){
connectDB() or die "Failed in subroutine";
#Selects customer name from customer table where code is $code
my $selectName = "SELECT * FROM customers WHERE code = ?";
my $sth = $dbh->prepare($selectName);
$sth->execute($code);
my $hash = $sth->fetchrow_hashref;
$hash->{customer_name} = $name;
return $name;
$sth ->finish();
$dbh->disconnect();
}
That's my module, here's my script:
#!/usr/bin/perl
require Connect;
use warnings;
my $dbh = Connect::connectDB();
my $results = Connect::selectCustomerName('38d');
print $results;
From a lot of messing around and switching variables I've got it to print 0, and the hash reference but never the actual value of the hash. Any help would be great thanks!
There are some mistakes. Try this:
use strict; use warnings; # never forget this 2 pragmas
use Data::Dumper; # print what's inside data structures or object
sub selectCustomerName {
my $code = shift; # or my ($code) = #_;
connectDB() or die "Failed in subroutine";
#Selects customer name from customer table where code is $code
my $selectName = "SELECT * FROM customers WHERE code = ?";
my $sth = $dbh->prepare($selectName);
$sth->execute($code);
my $hash = $sth->fetchrow_hashref;
print Dumper $hash;
$name = $hash->{customer_name};
$sth ->finish();
$dbh->disconnect();
return $name;
}
if you put finish() & disconnect() after the return, they will never be invoked.
Simplest way to see what you actually have is probably to use Data::Dumper.
#!/usr/bin/perl
use strict;
use warnings;
require Connect;
use Data::Dumper;
my $dbh = Connect::connectDB();
my $results = Connect::selectCustomerName('38d');
print Dumper $results;
But if you have a hash reference then you can deference it using %{$hash_ref} and use it as you use any other hash.
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
require Connect;
my $dbh = Connect::connectDB();
my $results = Connect::selectCustomerName('38d');
foreach (keys %{$results}) {
say "Key: $_, Value: $results->{$_}";
}

Perl Parallel::ForkManager with DBI database handlers

im interested in performing multiple database actions in parallel. I have played with Perl Parallel::ForkManager but not used it with any databases yet. I have read that database connectivity is not supported very well with this. Does anyone have experience with this?
As an example i would probably be spawning a system call(which does the DBI work) NOT raw code, i.e.
#!/opt/local/bin/perl -w
use strict;
use Parallel::ForkManager;
$| = 1;
my $max_procs = 10;
my $pm = new Parallel::ForkManager($max_procs);
for (my $var = 0; $var <= 10; $var++) {
my $pid = $pm->start('proc'.$var) and next;
sleep ( 2 );
system( "./DBworker.pl $var" );
$pm->finish(0);
}
print "Waiting for child procs\n";
$pm->wait_all_children;
print "complete!\n";
If the work is being done by other programs, there is no danger to forking. The danger comes when you open a connection to the database and then fork. The child can't reuse the parents connection; however, take a look at DBIx::Connector, it handles the things you need to do after forking for you and running multiple programs is generally not the right answer.
#!/usr/bin/perl
use strict;
use warnings;
use DBIx::Connector;
use Parallel::ForkManager;
my $dsn = "dbi:SQLite:dbname=foo.db";
my $user = "";
my $pass = "";
my $conn = DBIx::Connector->new($dsn, $user, $pass,
{
AutoCommit => 0,
PrintError => 0,
RaiseError => 1,
ChopBlanks => 1,
FetchHashKeyName => 'NAME_lc',
}
);
END { unlink "foo.db" }
#setup table
$conn->run(fixup => sub {
my $dbh = $_;
$dbh->do("create table foo ( id integer, name char(35) )");
my $sth = $dbh->prepare("insert into foo (id, name) values (?, ?)");
while (<DATA>) {
chomp;
$sth->execute(split /,/);
}
});
my $pm = Parallel::ForkManager->new(3);
my $sth = $conn->dbh->prepare("select * from foo where id = ?");
for my $id (1 .. 3) {
next if $pm->start;
$sth->execute($id);
while (my $row = $sth->fetchrow_hashref) {
print "$id saw $row->{id} => $row->{name}\n";
}
$pm->finish;
}
$pm->wait_all_children;
print "done\n";
__DATA__
1,foo
2,bar
3,baz