I have a Perl script which takes a file as input and has PL/SQL (for statements and DBMS_OUTPUT.PUT_LINE) in it. I need to run make a database connection and run that file in Perl script.The pl/sql has Begin declare end section,with for statements on it which is writing data of 3 columns separated using commas(DBMS_OUTPUT.PUT_LINE) I have shown what I have tried below. Is it correct?
my $dbh = DBI->connect( "dbi:Oracle:$db", $username, $passwd ) ||
die( $DBI::errstr . "\n" );
$dbh->{AutoCommit} = 0;
$dbh->{PrintError} = 1;
open FILE, $sql_file or die "Could not open file";
$query = '';
while($line = <FILE>) {
chomp($line);
$query .= $line;
}
my $sth = $dbh->prepare($query);
$sth->execute();
while ( my #row = $sth->fetchrow_array() ) {
foreach (#row) {
print "$_";
}
print "\n";
}
$sth->fetch(), $sth->fetchrow_*(), and friends all fetch records from a result set. In Oracle PL/SQL blocks don't normally return result sets. So calling $sth->fetchrow_array() after running a PL/SQL block won't return any results.
If your using DBMS_OUTPUT.PUT_LINE to output results you will need to use the dbms_output_* functions provided by DBD::Oracle.
my $dbms_output_byte_limit = 1000000;
$dbh->func( $dbms_output_byte_limit, 'dbms_output_enable' );
my $sth = $dbh->prepare($query);
$sth->execute();
my #text = $dbh->func( 'dbms_output_get' );
Related
I want to see how much time my query taking to execute using perl. Here is my work till now
#!/usr/bin/perl -w
use DBI;
use strict;
use warnings;
use diagnostics;
use POSIX qw(strftime);
my $driver = "mysql";
my $database = "employee";
my $dsn = "DBI:$driver:database=$database";
my $userid = "root";
my $password = "****";
my $sql_statement;
my $sth;
my $data;
my $row;
my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;
my $foo = "SET profiling=on;"."\n"."SELECT * FROM employee;"."\n"."SHOW PROFILES;";
open my $fh, "<", \$foo;
binmode $fh, ":encoding(utf8)";
while ($sql_statement = <$fh>)
{
$data = $dbh->selectall_arrayref($sql_statement) or die "issue is : $dbh->errstr";
}
my $retirement_date;
if (scalar #$data)
{
$retirement_date = strftime( "%F %H:%M:%S", localtime(time() - #$data[0]));
}
print $retirement_date;
but I am not getting any result.
expected output should be like this
5 15.86296022 SELECT * from employee;
where 5 is query id, 15.86296022 is execution time and last query.
Please suggest how to achieve this.
You're not getting any result because you're misunderstanding the data structure you're getting back from selectall_arrayref(). It's an arrayref of arrayrefs - so you need to look two levels deep in it in order to get the actual data.
I replaced the second part of your code with this:
while ($sql_statement = <$fh>) {
warn "$sql_statement\n";
$data = $dbh->selectall_arrayref($sql_statement) or die "issue is : $dbh->errstr";
print join(' | ', #$_), "\n" for #$data;
}
And when I run it, I get this:
$ perl dbprofile
SET profiling=on;
DBD::mysql::db selectall_arrayref failed: fetch() without execute() at dbprofile line 25, <$fh> line 1.
SELECT * FROM employee;
1 | Fred | 2020-09-09
2 | Bill | 2035-06-23
3 | Jane | 2058-03-11
SHOW PROFILES;
1 | 0.00027717 | SELECT * FROM employee
I'm not sure what's going on with the "fetch() without execute()" error and I don't have time to investigate it now. But you can see all of your data - including the profiling information.
Please see if following demo code provides desired output
#!/usr/bin/perl
#
# vim: ai:ts=4:sw=4
#
use strict;
use warnings;
use feature 'say';
use DBI;
use Config::General;
my($dsn,$dbh,$sth,$query,$rv);
my $conf = Config::General->new( "$ENV{HOME}/.my.cnf" );
my %config = $conf->getall;
# Keep password inside code
$config{password} = 'your_password_here';
$dsn = "DBI:mysql:database=$config{database};host=$config{host};port=$config{port}";
$dbh = DBI->connect($dsn, $config{user}, $config{password},
{
RaiseError => 1,
mysql_enable_utf8 => 1
});
$query = "SET PROFILING=on";
$sth = $dbh->prepare($query) or die $dbh->errstr;
$rv = $sth->execute() or die $dbh->errstr;
#say $DBI::errstr if $rv < 0;
my $db_table = 'your_db_table_here';
$query = "SELECT * FROM $db_table";
$sth = $dbh->prepare($query) or die $dbh->errstr;
$rv = $sth->execute() or die $dbh->errstr;
#say $DBI::errstr if $rv < 0;
$query = "SHOW PROFILES";
$sth = $dbh->prepare($query) or die $dbh->errstr;
$rv = $sth->execute() or die $dbh->errstr;
#say $DBI::errstr if $rv < 0;
while( my $row = $sth->fetchrow_arrayref ) {
say join("\t",#{$row});
}
$query = "SET PROFILING=off";
$sth = $dbh->prepare($query) or die $dbh->errstr;
$rv = $sth->execute() or die $dbh->errstr;
#say $DBI::errstr if $rv < 0;
$sth->finish();
$dbh->disconnect();
Sample of $ENV{HOME}/.my.cnf file
[mysql]
host=yout_db_host_name
user=your_db_user_name
database=your_db_name
default-character-set=utf8
port=3306
Sample of output
1 0.0014745 SELECT * FROM new_movies
I need to query a group of SAP sybase databases for some information and print that as a comma spearated list. So I figure I write a perl script that connects to any of those databases via DBI module. Here is what I came up with.
my $user = "someuser";
my $passwd = "somepassword";
my #sids=(filled with DB identifiers);
my $output="";
my $size;
my $version;
my $id;
my $dsn;
my $dbh;
my $sid;
my #row;
my $sth1;
my $sth2;
foreach $sid (#sids) {
print $sid."\n";
$dsn = "dbi:Sybase:server=$sid;charset=iso_1;tdsLevel=CS_TDS_50";
print $dsn."\n";
$dbh = DBI->connect($dsn, $user, $passwd,{ PrintError => 0,RaiseError => 0, AutoCommit => 1, syb_enable_utf8 => 1});
print "DBI OK\n" if defined ($dbh);
$sth1 = $dbh->prepare('select SUM(size) from master..sysusages WHERE dbid = 4 AND segmap = 3');
$sth2 = $dbh->prepare('select ##version');
$sth1->execute;
while (#row = $sth1->fetchrow) {
$size = $row[0];
}
$size = $size * 16 / 1024;
$sth1->finish;
$sth2->execute;
while (#row = $sth2->fetchrow) {
$version = $row[0];
}
$sth2->finish;
$output = $sid.",".$size.",".$version;
$dbh->disconnect;
print $output."\n";
}
When I execute this, it crashes after 4th iteration, because the connection handle is not set. So the connection of the fifth DB does not work anymore.
Can't call method "prepare" on an undefined value at ./check_sybasedbs.pl line 36.
Line 36 is the preparation of statement 1.
I tried putting sleep commands at various positions. I also tried to explicitly clean up the variables that are reused via undef. Now I am out of ideas and would really appreciate your input.
Your code could be written as sample below (please see if ... else ... block for $dbh)
use strict;
use warnings;
use feature 'say';
use DBI;
my($user, $passwd) = qw/someuser somepassword/;
my #sids = qw/server1 server2 ... server#/;
foreach my $sid (#sids) {
my $dsn = "dbi:Sybase:server=$sid;charset=iso_1;tdsLevel=CS_TDS_50";
say "DSN: $dsn";
my $dbh = DBI->connect($dsn, $user, $passwd, { PrintError => 1,
RaiseError => 1,
AutoCommit => 1,
syb_enable_utf8 => 1
}
);
if( not defined ($dbh) ) {
say "WARNING: Could not connect to $dsn";
} else {
say "INFO: DB connection established";
my($size,$version);
my $query = 'SELECT
SUM(size)
FROM
master..sysusages
WHERE
dbid = 4
AND
segmap = 3
';
my $sth = $dbh->prepare($query);
$sth->execute;
while (#row = $sth->fetchrow) {
$size = $row[0];
}
$sth->finish;
$query = 'select ##version';
$sth = $dbh->prepare($query);
$sth->execute;
while (#row = $sth->fetchrow) {
$version = $row[0];
}
$sth->finish;
$dbh->disconnect;
$size = $size * 16 / 1024;
say "SID: $sid, SIZE: $size, VERSION: $version";
}
}
NOTE: use strict; use warnings; helps to avoid many pitfalls, use diagnostics; helps to identify a problem in difficult cases
NOTE: $sth->fetchrow_hashref allows address hash element by name, no need to count index of array as in case $sth->fetch_rowarray
in my naiv thinking I hid some lines of code that I was convinced could not be the reason for this misbehaviour. As it turns out, it was. So the reason for my problem was a simple logical error, that caused the password, that was used after a connect to a certain DB to be wrong.
I have few lines in my array #lines in which * shows me the start time of a command (like sync/fetch) and the line with same processID pid and the command without * shows me the end time. They may not be continuous always. I would like to get the startdate and enddate of a particular processID and cmd. Like for usera the cmd sync with processID 11859 started at 2015/01/13 13:53:01.491-05:00 and ended at 2015/01/13 13:55:01.492-05:00
Below is my approach in which I took a hash of array and used processID as key and did split the lines. This works fine only when the start and end lines of a command are continuous , but how can I make it work even when they are not continuous.
my %users;
foreach my $line (#lines) {
if ($line =~ m{(\*)+}) {
($stdate, $sttime, $pid, $user, $cmd) = split ' ', $line;
$startdate ="$stdate $sttime";
}
else {
($eddate, $edtime, $pid, $user, $cmd) = split ' ', $line;
$enddate = "$eddate $edtime";
}
$users{$pid} = [ $startdate, $enddate, $user, $cmd ];
}
Content in #lines:
2015/01/13 13:53:01.491-05:00 11859 usera *sync_cmd 7f1f9bfff700 10.101.17.111
2015/01/13 13:57:02.079-05:00 11863 userb *fetch_cmd 7f1f9bfff700 10.101.17.111
2015/01/13 13:59:02.079-05:00 11863 userb fetch_cmd 7f1f9bfff700 10.101.17.111
2015/01/13 13:55:01.492-05:00 11859 usera sync_cmd 7f1f9bfff700 10.101.17.111
I'm looking at your code and wondering why you're using a hash of arrays.
As far as I'm concerned, the purpose of array is a set of similar but ordered values.
Could you not instead do:
my %processes;
foreach (#lines) {
my ( $date, $time, $pid, $user, $cmd, #everything_else ) = split;
if ( $cmd =~ m/^\*/ ) {
#if command starts with a * - it started.
if ( defined $processes{$pid} ) {
print "WARNING: $pid reused\n";
}
$processes{$pid}{'start_date'} = $date;
$processes{$pid}{'time'} = $time;
$processes{$pid}{'user'} = $user;
$processes{$pid}{'cmd'} = $cmd;
}
else {
#cmd does not start with '*'.
if ( $processes{$pid}{'cmd'} =~ m/$cmd/ ) {
#this works, because 'some_command' is a substring of '*some_command'.
$processes{$pid}{'end_date'} = $date;
$processes{$pid}{'end_time'} = $time;
}
else {
print
"WARNING: $pid has a command of $cmd, where it started with $processes{$pid}{'cmd'}\n";
}
}
}
You might want some additional validation tests in case you've got e.g. a long enough log that pids get reused, or e.g. you've got a log that doesn't include both start and finish of a particular process.
When you assign to %users{$pid} you are presuming that the most recent $startdate and $enddate are both relevant. This problem is exacerbated by the fact that your variables that hold your field values have a scope larger than the foreach loop, allowing these values to bleed between records.
In the if block, you should assign the values of $startdate, $user, $cmd to the array. Individually or as a slice if you like. In the else block you should assign $enddate to it's element in the array.
Regex extra credit: You don't seem to really care if there is more that one * in a record, making the + in the regex superfluous. As an added bonus, without it the capturing group is also of no value. m{\*} should do quite nicely.
Hi I tried to select one random number from this:
My source:
use DBI;
use CGI;
my $file = '.\input.txt'; # Name the file
open(FILE, $file) or die("Unable to open file");
my #data = <FILE>;
foreach my $line (#data)
{
chomp $line
my $sth = $dbh->prepare("SELECT columnA FROM table WHERE columnA LIKE '%$line%'");
$sth->execute;
my $result = $sth->fetchall_arrayref;
foreach my $row ( #$result ) {
print "- ";
print "#$row\n";
print "<BR />";
}
}
How can I print only ONE RANDOM row???
I tried something like that:
my $sth = $dbh->prepare("SELECT nazov_receptu FROM recepty WHERE nazov_receptu LIKE '%$line%' AND kategoria == 'p' AND (rowid = (abs(random()) % (select max(rowid)+1 from recepty)) or rowid = (select max(rowid) from recepty)) order by rowid limit 1;");
but its not clear... i dont know why...
I am using SQLite and printing it to web interface.
You can try it when you have
input.txt:
A
C
database:
id name
1 A
2 B
3 C
4 D
5 E
OUT:
A OR C (random)
Why not join the file arguments into the query right away instead of looping over them? Then it is a simple matter to extract a random index in perl:
use strict;
use warnings; # Always use these two pragmas
my $file = '.\input.txt';
open my $fh, "<", $file or die "Unable to open file: $!";
chomp(my #data = <$fh>); # chomp all lines at once
my $query = "SELECT columnA FROM table WHERE ";
$query .= join " OR ", ( "columnA LIKE ?" ) x #data;
# add placeholder for each line
#data = map "%$_%", #data; # add wildcards
my $sth = $dbh->prepare($query);
$sth->execute(#data); # execute query with lines as argument
my $result = $sth->fetchall_arrayref;
my $randid = rand #$result; # find random index
my $row = $result->[ $randid ];
print "- #$row\n";
print "<BR />";
As you see, I've used placeholders, which is the proper way to use variables with queries. It also happens to be a simple way to handle an arbitrary amount of arguments. Because we include all lines in the query, we do not need a for loop.
As you see, I've also changed a few other small details, such as using three argument open with a lexical file handle, including the error variable $! in the die statement, using proper indentation, using strict and warnings (you should never code without them)
I've handled the randomization in perl because it is simplest for me. It may be as simple and more effective to handle in the SQL query. You may just tack on the ORDER BY random() LIMIT 1 to the end of it, and that might work just fine too.
Perhaps order by random(),
SELECT nazov_receptu FROM recepty ORDER BY RANDOM() LIMIT 1;
If you want to fetch only one random row, make sure to put this code out of the loop,
my $sth = $dbh->prepare("SELECT nazov_receptu FROM recepty ORDER BY RANDOM() LIMIT 1");
$sth->execute;
my ($nazov_receptu) = $sth->fetchrow_array;
Because your query is inside the foreach my $line (#data) loop, it will run once for each item in #data, getting a different random row each time. If you want it to only run once total, you need to move it outside of that loop (in addition to using "order by random() limit 1").
I'm relatively new to Perl and I've come across this project that I'm having a bit of a hard time with.
The object of the project is to compare two csv files, one of which would contain:
$name, $model, $version
and the other which would contain:
$name2,$disk,$storage
in the end the RESULT file will contain that matched lines and put together the information like so:
$name, $model, $version, $disk,$storage.
I've managed to do this, but my problem is that when one of the elements in missing the program breaks. When it encounters a line in the file missing an element it stops at that line. How can I fix this problem? any suggestions or a way as to how I can perhaps make it skip that line and continue on?
Here's my code:
open( TESTING, '>testing.csv' ); # Names will be printed to this during testing. only .net ending names should appear
open( MISSING, '>Missing.csv' ); # Lines with missing name feilds will appear here.
#open (FILE,'C:\Users\hp-laptop\Desktop\file.txt');
#my (#array) =<FILE>;
my #hostname; #stores names
#close FILE;
#***** TESTING TO SEE IF ANY OF THE LISTED ITEMS BEGIN WITH A COMMA AND DO NOT HAVE A NAME.
#***** THESE OBJECTS ARE PLACED INTO THE MISSING ARRAY AND THEN PRINTED OUT IN A SEPERATE
#***** FILE.
#open (FILE,'C:\Users\hp-laptop\Desktop\file.txt');
#test
if ( open( FILE, "file.txt" ) ) {
}
else {
die " Cannot open file 1!\n:$!";
}
$count = 0;
$x = 0;
while (<FILE>) {
( $name, $model, $version ) = split(","); #parsing
#print $name;
chomp( $name, $model, $version );
if ( ( $name =~ /^\s*$/ )
&& ( $model =~ /^\s*$/ )
&& ( $version =~ /^\s*$/ ) ) #if all of the fields are blank ( just a blank space)
{
#do nothing at all
}
elsif ( $name =~ /^\s*$/ ) { #if name is a blank
$name =~ s/^\s*/missing/g;
print MISSING "$name,$model,$version\n";
#$hostname[$count]=$name;
#$count++;
}
elsif ( $model =~ /^\s*$/ ) { #if model is blank
$model =~ s/^\s*/missing/g;
print MISSING"$name,$model,$version\n";
}
elsif ( $version =~ /^\s*$/ ) { #if version is blank
$version =~ s/^\s*/missing/g;
print MISSING "$name,$model,$version\n";
}
# Searches for .net to appear in field "$name" if match, it places it into hostname array.
if ( $name =~ /.net/ ) {
$hostname[$count] = $name;
$count++;
}
#searches for a comma in the name feild, puts that into an array and prints the line into the missing file.
#probably won't have to use this, as I've found a better method to test all of the feilds ( $name,$model,$version)
#and put those into the missing file. Hopefully it works.
#foreach $line (#array)
#{
#if($line =~ /^\,+/)
#{
#$line =~s/^\,*/missing,/g;
#$missing[$x]=$line;
#$x++;
#}
#}
}
close FILE;
for my $hostname (#hostname) {
print TESTING $hostname . "\n";
}
#for my $missing(#missing)
#{
# print MISSING $missing;
#}
if ( open( FILE2, "file2.txt" ) ) { #Run this if the open succeeds
#open outfile and print starting header
open( RESULT, '>resultfile.csv' );
print RESULT ("name,Model,version,Disk, storage\n");
}
else {
die " Cannot open file 2!\n:$!";
}
$count = 0;
while ( $hostname[$count] ne "" ) {
while (<FILE>) {
( $name, $model, $version ) = split(","); #parsing
#print $name,"\n";
if ( $name eq $hostname[$count] ) # I think this is the problem area.
{
print $name, "\n", $hostname[$count], "\n";
#print RESULT"$name,$model,$version,";
#open (FILE2,'C:\Users\hp-laptop\Desktop\file2.txt');
#test
if ( open( FILE2, "file2.txt" ) ) {
}
else {
die " Cannot open file 2!\n:$!";
}
while (<FILE2>) {
chomp;
( $name2, $Dcount, $vname ) = split(","); #parsing
if ( $name eq $name2 ) {
chomp($version);
print RESULT"$name,$model,$version,$Dcount,$vname\n";
}
}
}
$count++;
}
#open (FILE,'C:\Users\hp-laptop\Desktop\file.txt');
#test
if ( open( FILE, "file.txt" ) ) {
}
else {
die " Cannot open file 1!\n:$!";
}
}
close FILE;
close RESULT;
close FILE2;
I think you want next, which lets you finish the current iteration immediately and start the next one:
while (<FILE>) {
( $name, $model, $version ) = split(",");
next unless( $name && $model && $version );
...;
}
The condition that you use depends on what values you'll accept. In my examples, I'm assuming that all values need to true. If they need to just not be the empty string, maybe you check the length instead:
while (<FILE>) {
( $name, $model, $version ) = split(",");
next unless( length($name) && length($model) && length($version) );
...;
}
If you know how to validate each field, you might have subroutines for those:
while (<FILE>) {
( $name, $model, $version ) = split(",");
next unless( length($name) && is_valid_model($model) && length($version) );
...;
}
sub is_valid_model { ... }
Now you just need to decide how to integrate that into what you are already doing.
You should start by adding use strict and use warnings to the top of your program, and declaring all variables with my at their point of first use. That will reveal a lot of simple mistakes that are otherwise difficult to spot.
You should also use the three-parameter for of open and lexical filehandles, and the Perl idiom for checking exceptions on opening files is to add or die to an open call. if statements with an empty block for the success path waste space and become unreadable. An open call should look like this
open my $fh, '>', 'myfile' or die "Unable to open file: $!";
Finally, it is much safer to use a Perl module when you are handling CSV files as there are a lot of pitfalls in using a simple split /,/. The Text::CSV module has done all the work for you and is available on CPAN.
You problem is that, having read to the end of the first file, you don't rewind or reopen it before reading from the same handle again in the second nested loop. That means no more data will be read from that file and the program will behave as if it is empty.
It is a bad strategy to read through the same file hundreds of times just to pair up coresponding records. If file is of a reasonable size you should build a data structure in memory to hold the information. A Perl hash is ideal as it allows you to look up the data corresponding to a given name instantly.
I have written a revision of your code that demonstrates these points. It would be awkward for me to test the code as I have no sample data, but if you continue to have problems please let us know.
use strict;
use warnings;
use Text::CSV;
my $csv = Text::CSV->new;
my %data;
# Read the name, model and version from the first file. Write any records
# that don't have the full three fields to the "MISSING" file
#
open my $f1, '<', 'file.txt' or die qq(Cannot open file 1: $!);
open my $missing, '>', 'Missing.csv'
or die qq(Unable to open "MISSING" file for output: $!);
# Lines with missing name fields will appear here.
while ( my $line = csv->getline($f1) ) {
my $name = $line->[0];
if (grep $_, #$line < 3) {
$csv->print($missing, $line);
}
else {
$data{$name} = $line if $name =~ /\.net$/i;
}
}
close $missing;
# Put a list of .net names found into the testing file
#
open my $testing, '>', 'testing.csv'
or die qq(Unable to open "TESTING" file for output: $!);
# Names will be printed to this during testing. Only ".net" ending names should appear
print $testing "$_\n" for sort keys %data;
close $testing;
# Read the name, disk and storage from the second file and check that the line
# contains all three fields. Remove the name field from the start and append
# to the data record with the matching name if it exists.
#
open my $f2, '<', 'file2.txt' or die qq(Cannot open file 2: $!);
while ( my $line = $csv->getline($f2) ) {
next unless grep $_, #$line >= 3;
my $name = shift #$line;
next unless $name =~ /\.net$/i;
my $record = $data{$name};
push #$record, #$line if $record;
}
# Print the completed hash. Send each record to the result output if it
# has the required five fields
#
open my $result, '>', 'resultfile.csv' or die qq(Cannot open results file: $!);
$csv->print($result, qw( name Model version Disk storage ));
for my $name (sort keys %data) {
my $line = $data{$name};
if (grep $_, #$line >= 5) {
$csv->print($result, $data{$name});
}
}