Add eight thousand line in one commit [closed] - linux

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 years ago.
Improve this question
I have a log file, perl script who took the log file and transcript the log file, i want to send this all line (eight thousand line) in one commit
my script:
# Connect to the database.
my $dbh = DBI->connect(
"DBI:mysql:database=DB;host=>IP",
"hostname", 'password',
{'RaiseError' => 1,'AutoCommit'=> 0}
);
open (FILE, 'file.log');
while (<FILE>) {
($word1, $word2, $word3, $word4, $word5, $word6, $word7, $word8, $word9, $word10, $word11, $word12, $word13, $word14) = split(" ");
$word13 =~ s/[^\d.]//g;
if ($word2 eq "Feb") {
$word2 = "02"
}
print "'$word5-$word2-$word3 $word4', $word11, $word13 \n";
eval {
#on peut utiliser insert mais il y aura des doublons et ici on est dans une table unique
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES('$word5-$word2-$word3 $word4', $word11, $word13);");
#print $sth->rows . " rows found.\n";
#$sth->finish;
# do inserts, updates, deletes, queries here
#$sth->execute() or die "execution failed: $dbh->errstr()";
$sth->execute() or die "execution failed: $dbh->errstr()";
$dbh->commit();
};
### If something went wrong...
}
}
$dbh->disconnect();
thanks

For better performance, you want to simplify your code and move as many code as possible out of the loop :
prepare the statement out of the loop, using bind parameters : the statement is always the same, only bind parameters get to change
commit out of the loop : this will increase performance and also has the advantage of making your process atomic. As all changes occur within the same database transaction, either all lines will be processed (and commited), or, if a failure occurs on any line, no line at all will be commited. While implementing this optimization you need to watch for resource usage on your database (this will typically require more space in the UNDO tablespace) ; if resources are not enough, either increase them or commit every Nth record (with N being as high as possible)
avoid printing inside the loop unless your really need it (I commented that line)
you are building a connection with RaiseError attribute enabled, but then you ignore errors that can occur at execute. If this is really what you want, then just disable the RaiseError attribute on the statement handler, and remove the eval around execute
Other considerations in terms of coding practices :
always use strict and use warnings
use an array to store parsed data instead of a list of scalars : could make your code faster and will make it more readable
Code :
use strict;
use warnings;
# Connect to the database.
my $dbh = DBI->connect(
"DBI:mysql:database=DB;host=>IP",
"hostname", 'password',
{'RaiseError' => 1,'AutoCommit'=> 0}
);
# prepare the insert statement
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES(?, ?, ?)");
$sth->{RaiseError} = 0;
open (my $file, 'file.log') or die "could not open : $!";
while (<$file>) {
my #words = split / /;
$words[12] =~ s/[^\d.]//g;
if ($words[1] eq "Feb") {
$words[1] = "02" ;
}
# print "'$words[4]-$words[1]-$words[2] $words[3]', $words[10], $words[12] \n";
$sth->execute( "$words[4]-$words[1]-$words[2] $words[3]", $words[10], $words[12] );
}
$dbh->commit;
$dbh->disconnect;
The last solution, that would probably perform even faster than this one, is to use DBI method execute_array to perform bulk database inserts. Attribute ArrayTupleFetch can be used to provide a code reference that DBI will invoke everytime it is ready to perform the next INSERT : this code reference should read the next file line and provide an array reference of values suitable for INSERT. When the file is exhausted, the sub should return undef, which will indicate DBI that the bulk process is completed.
Code :
#!/usr/local/bin/perl
use strict;
use warnings;
use DBI;
# open the file
open (my $file, 'log.file') or die "could not open : $!";
# connect the database
my $dbh = DBI->connect("DBI:mysql:database=DB;host=ip", "hostname", 'password', {'RaiseError' => 1,'AutoCommit'=> 0});
# prepare the INSERT statement
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES(?, ?, ?)");
# run bulk INSERTS
my $tuples = $sth->execute_array({
ArrayTupleStatus => \my #tuple_status,
ArrayTupleFetch => sub {
my $line = <$file>;
return unless $line;
my #words = split / /;
# ... do anything you like with the array, then ...
return [ "$words[4]-$words[1]-$words[2] $words[3]", $words[10], $words[12] ];
}
});
if ($tuples) {
print "Successfully inserted $tuples records\n";
} else {
# do something usefull with #tuple_status, that contains the detailed results
}
$dbh->commit;
$dbh->disconnect;

Related

Perl Device::SerialPort

Looking for right way to detect one keyword during board boot up message.
After keyword detected, send Enter key after one second.
Kernel is Linux.
# Serial port inisialisation is finished here.
# Read boot message
($count, $result) = $ob->read(300); # at least 300 chars coming till keyword appear
if ($result =~ m/Booting_up/) {
print "send Enter ...\n";
sleep 1;
$ob->write("\r\n");
}
Thanks for hint
It appears that you are using Win32::SerialPort module, or perhaps Device::SerialPort which
provides an object-based user interface essentially identical to the one provided by the Win32::SerialPort module.
Its method read takes the number of bytes to read and returns the number read and writes them into the given string.
You may be "missing" the phrase because it's past the 300-mark, and your code doesn't read any further. Try to loop, getting a few bytes at a time and adding them up, thus building the string in small reads.
my bytes_in = 10; # length of pattern, but it does NOT ensure anything
my ($read, $result);
while (1)
{
my ($count, $read) = $ob->read( $bytes_in );
$result = $result . $read;
if ($result =~ m/Booting_up/) { # is it "Booting_up" or "Booting up" ?
print "send Enter ...\n";
sleep 1; # is this needed?
$ob->write("\r\n");
# last; # in case this is all you need to do
}
last if $count != $bytes_in; # done reading
}
I don't put the $ob->read statement in the loop condition since the documentation isn't crystal clear on how the method works. You may also be able to simply use
while ( my ($count, $read) = $ob->read( $bytes_in ) ) {
$result = $result . $read;
if ($result =~ m/Booting_up/s) {
# ...
}
last if $count != $bytes_in;
}
We read a small number of bytes at a time to prevent problems with either polling or blocking reads, brought up in comments by BenPen. See Configuration and capability methods.
You can first read those first 300 bytes that precede the pattern in one go and then start reading a few (or one) at a time, which would also lead to the quickest identification of the phrase.
This can be tweaked further but let's first see what it does as it stands (I cannot test).
Documentation also offers a few other methods which may be useful, in particular readline and streamline. As this is all rather low level there are yet other ways but if you got all else working perhaps this will be enough to complete it.
Perhaps rather index the string?
($count, $result) = $ob->read(300); # at least 300 chars coming till keyword appear
$substring = 'Booting_up';
if (index($result, $substring) != -1) {
print "send Enter ..\n";
sleep 1;
$ob->write("\r\n");
}

Perl multithreading - thread doesn't start

I need some help, I can't figure out why my thread doesn't want to start. I don't have experience with perl, and was asked to make a script that will process a file row by row. Depending on the row, the process should execute other functions (not in snippet), call the same function on a new file or call the same function on a new file in parallel (thread).
Below, I pasted a snippet of the actual code (removed the non-relevant code).
I'm testing the multithreading part on a function called "test" which should print "ok".
The process executes correctly, "start" is printed, but then it gets stuck and after a brief delay, the process stops executing completely.
A thousand thanks to whoever may help me!
use strict;
use warnings;
use IO::Prompter;
use Getopt::Long;
use Log::Message::Simple;
use File::Basename;
use File::Spec;
use IO::Socket::INET;
use UUID::Tiny ':std';
use threads;
use threads::shared;
# *bunch of code deleted*
process_file( $cmdline{csvfile}, 1 );
sub test {
print "ok\n";
}
sub process_file {
# get parameters
my ( $input_file, $flowid ) = #_;
# init variables
# open input file
open( my $fh, '<:encoding(UTF-8)', $input_folder . $input_file )
or die "Could not open file '$input_file' $!";
# process file
while ( my $row = <$fh> ) {
chomp $row;
#request = split ";", $row;
$flow_type = $request[0];
$flow = $request[1];
# *bunch of code deleted*
$filename = "$flow.csv";
$keep_flowid = $request[2]; # keep flowid?
$tmp_flowid = $keep_flowid ? $flowid : undef; # set flowid
$thread = $request[3];
if ( $thread == 1 ) {
### Create new thread
print "start\n";
my $process_thread = threads->create("test");
$process_thread->join();
}
elsif ( $thread == 0 ) {
# wait on process to complete
process_file( $filename, $tmp_flowid );
}
# *bunch of code deleted*
}
# close file
close $fh or die "Couldn't close inputfile: $input_file";
}
It's hard to say exactly why you're having this problem - the major possiblity seems to be:
$thread = $request[3];
if ($thread == 1){
This is input from your filehandle, so a real possiblity is that "$request[3]" isn't actually 1.
I am a bit suspicious though - your code as use strict; use warnings at the top, but you're not declaring e.g. $thread, $flow etc. with my. That either means you're not using strict, or you're reusing variables - which is a good way to end up with annoying glitches (like this one).
But as it stands - we can't tell you for sure, because we cannot reproduce the problem to test it. In order to do this, we would need some sample input and a MCVE
To expand on the point about threads made in the comments - you may see warnings that they are "Discouraged". The major reason for this, is because perl threads are not like threads in other languages. They aren't lightweight, where in other languages they are. They're perfectly viable solutions to particular classes of problems - specifically, the ones where you need parallelism with more IPC than a fork based concurrency model would give you.
I suspect you are experiencing this bug, fixed in Perl 5.24.
If so, you could work around it by performing your own decoding rather than using an encoding layer.

How to modify a perl script to read excel instead of Html files

My first question is:
Is this possible to do this, since now I have a perl script which reads Html file and extract data to display on another html file.
If the answer for the question above is Yes, my second question would be:
How to do this?
Sorry to ask frankly as this, but since I'm so new for perl, and I have to take this task, so I'm here for some useful advice or suggestion to guide me through this task. Appreciate your help in advance.
Here's a part of the code, since the whole chunk is quite long:
$date=localtime();
($TWDAY, $TMTH, $TD1D, $TSE, $TYY) = split(/\s+/, $date);
$TSE =~ s/\://g;
$STAMP=_."$TD1D$TMTH$TYY";
#ServerInfo=();
#--------------------------------------------------------------------------- -------------------------------
# Read Directory
#----------------------------------------------------------------------------------------------------------
$myDir=getcwd;
#----------------------------------------------------------------------------------------------------------
# INITIALIZE HTML FORMAT
#----------------------------------------------------------------------------------------------------------
&HTML_FORMAT;
#----------------------------------------------------------------------------------------------------------
# REPORT
#----------------------------------------------------------------------------------------------------------
if (! -d "$myDir/report") { mkdir("$myDir/report");};
$REPORTFILE="$myDir/report/checkpack".".htm";
open OUT,">$REPORTFILE" or die "\nCannot open out file $REPORTFILE\n\n";
print OUT "$Tag_Header";
#----------------------------------------------------------------------------------------------------------
sub numSort {
if ($b < $a) { return -1; }
elsif ($a == $b) { return 0;}
elsif ($b > $a) { return 1; }
}
#ArrayDir = sort numSort #DirArray;
#while (<#ArrayDir>) {
#OutputDir=grep { -f and -T } glob "$myDir/*.htm $myDir/*.html";
#}
#----------------------------------------------------------------------------------------------------------
#ReadLine3=();
$xyxycnt=0;
foreach $InputFile (#OutputDir) { #---- MAIN
$filename=(split /\//, $InputFile) [-1]; print "-"x80 ; print "\nFilename\t:$filename\n";
open IN, "<$InputFile" or die "Cannot open Input file $InputFile\n";
#MyData=();
$DataCnt=0;
#MyLine=();
$MyLineCnt=0;
while (<IN>) {
$LINE=$_;
chomp($LINE);
$LINE=~s/\<br\>/XYXY/ig;
$LINE=~s/\<\/td\>/ \nXYZXYZ\n/ig;
$LINE=~s/\<dirname\>/xxxdirnameyyy/ig;
$LINE=linetrim3($LINE);
$LINE=linetrim($LINE);
$LINE=~s/XYXY/\<br\>/ig;
$LINE=~s/xxxdirnameyyy/&lt dirname &gt/ig;
$LINE=~s/^\s+//ig;
print OUT2 "$LINE\n";
if (defined($LINE)) { $MyData[$DataCnt]="$LINE"; $DataCnt++ ; }
}
close IN;
foreach $ReadFile (#MyData) { #--- Mydata
$MyLineCnt++;
$MyLine[$MyLineCnt]="";
#### FILENAME
$ServerInfo[0]="$filename";
#### IP ADDRESS
if ($ReadFile =~ /Host\/Device Name\:/) {
#print "$ReadFile\n"
($Hostname)=(split /\:|\s+/, $ReadFile)[3]; print "$Hostname\n";
&myServerInfo("$Hostname","1");
}
if ($ReadFile =~ /IP Address\(es\)/) {#ListIP=(); $SwIP=1; $CntIP=0 ; };
#### OPERATING SYSTEM & VERSION
if ($ReadFile =~ /Operating System\:/) {
$SwIP=0;
$OS= (split /\:|\s+/, $ReadFile)[3]; &myServerInfo("$OS","3") ; print "$OS\n";
$OSVer= (split /\:|\s+/, $ReadFile)[-2]; &myServerInfo("$OSVer","4") ; print "$OSVer\n";
};
#### GET IP VALUE
if ($SwIP==1) {
$ReadFile=(split /\:/,$ReadFile) [2];
$ReadFile=~s/[a-z|A-Z]|\(|\)|\// /ig; print "$ReadFile\n";
if ($CntIP==0) {
#$ListIP[$CntIP]=(split /\s+/,$ReadFile) [1];
#ListIP="$ReadFile";
} elsif ($CntIP==1) { print "\n\t\t $ReadFile\n" ; $ListIP[$CntIP]="\n$ReadFile";
} else { print "\t\t $ReadFile\n" ; $ListIP[$CntIP]="\n$ReadFile"; };
$CntIP++;
}
I'm afraid if you don't understand what is going on in this program and you also don't understand how to approach a task like this at all, Stack Overflow might not be the right place to get help.
Let me try to show you the approach I would take with this. I'm assuming there is more code.
First, write down a list of everything you know:
What is the input format of the existing file
Where does the existing file come from now
What is the output format of the existing file
Where does the generated output file go afterwards
What does the new file look like
Where does the new file come from
Use perltidy to indent the inherited code so you can read it better. The default options should be enough.
Read the code, take notes about what pieces do what, add comments
Write a unit test for the desired output format. You can use Test::More. Another useful testing module here is Test::File.
Refactor the part that generated the output format to work with a certain data structure. Use your tests to make sure you don't break it.
Write code to parse the new file into the data structure from the point above. Now you can plug that in and get the expected output.
Refactor the part that takes the old input file from the existing file location to be a function, so you can later switch it for the new one.
Write code to get the new file from the new file location.
Document what you did so the next guy is not in the same situation. Remember that could be you in half a year.
Also add use strict and use warnings while you refactor to catch errors more easily. If stuff breaks because of that, make it work before you continue. Those pragmas tell you what's wrong. The most common one you will encounter is Global symbol "$foo" requires explicit package name. That means you need to put my in front of the first assignment, or declare the variable before.
If you have specific questions, ask them as a new question with a short example. Read how to ask to make sure you will get help on those.
Good luck!
After seing your comment I am thinking you want a different input and a different output. In that case, disregard this, throw away the old code and start from scratch. If you don't know enough Perl, get a book like Curtis Poe's Beginning Perl if you already know programming. If not, check out Learning Perl by Randal L. Schwartz.

format the following result file into a tabular format using Perl

I have a sort of a problem, and I am still novice with Perl.
I just want to ask how can I format the following results file into an Excel readable format (let's say CSV).
Result file example. llq1_dly.mt0
$MEAS COMMANDS SOURCE='llq1_dly.meas' DB FILE='clk_top_45h_lpe_sim.fsdb'
.TITLE '**-------------'
tdrll10_0 tdfll10_0 tdrll10_1 tdfll10_1 tdrll10_2 tdfll10_2 tdrll10_3
2.106560e-10 1.990381e-10 2.102583e-10 1.986280e-10 2.095036e-10 1.978480e-10 2.083813e-10
into the following file with a result like this one below
llq1_dly,tdr,tdf,
ll10_0,2.106560e-10,1.990381e-10,
ll10_1,2.102583e-10,1.986280e-10,
ll10_2,2.095036e-10,1.978480e-10,
ll10_3,2.083813e-10,1.967019e-10,
...
or more likely this one (to be compatible with engineering scientific notations):
llq1_dly,tdr,tdf,
ll10_0,210.6560e-12,199.0381e-12,
ll10_1,210.2583e-12,198.6280e-12,
ll10_2,209.5036e-12,197.8480e-12,
ll10_3,208.3813e-12,196.7019e-12,
...
Here's a program that produces the output you ask for. I don't generally approve of offering answers to questions where the OP hasn't made any attempt to write a solution themselves, but this question interested me.
It may well be that this could be written more simply, but you don't say what parts of the input are invariant. For instance, I have written it so that there can be any number of different columns with any names, rather than just tdr and tdf every time. As it is I have had to guess that the trailing part of each header ends in ll, so for instance tdrll10_0 is tdr and ll10_0. If that is wrong then you will need a different way of splitting the string.
I have written the program so that it reads from the DATA file handle. I trust you are able to write an open statement to read from the correct input file?
I hope this helps
use strict;
use warnings;
use 5.010;
use Number::FormatEng 'format_eng';
Number::FormatEng::use_e_zero();
my $fh = \*DATA;
my ($source, #headers, #values);
while ( <$fh> ) {
if ( /SOURCE=(?|'([^']+)'|"([^"]+)")/ ) { #' code highlighting fix
($source = $1) =~ s/\.[^.]*\z//;
}
elsif ( /^\.TITLE/ ) {
#headers = split ' ', <$fh>;
#values = split ' ', <$fh>;
last;
}
}
my #title = ( $source );
my (%headers, #table, #line);
for my $i ( 0 .. $#headers) {
my #fields = split /(?=ll)/, $headers[$i];
if ( $headers{$fields[0]} ) {
push #table, [ #line ];
#line = ();
%headers = ();
}
++$headers{$fields[0]};
push #line, $fields[1] if #line == 0;
push #line, format_eng($values[$i]);
push #title, $fields[0] unless #table;
}
print "$_," for #title;
print "\n";
for ( #table ) {
print "$_," for #$_;
print "\n";
}
__DATA__
$MEAS COMMANDS SOURCE='llq1_dly.meas' DB FILE='clk_top_45h_lpe_sim.fsdb'
.TITLE '**-------------'
tdrll10_0 tdfll10_0 tdrll10_1 tdfll10_1 tdrll10_2 tdfll10_2 tdrll10_3
2.106560e-10 1.990381e-10 2.102583e-10 1.986280e-10 2.095036e-10 1.978480e-10 2.083813e-10
output
llq1_dly,tdr,tdf,
ll10_0,210.656e-12,199.0381e-12,
ll10_1,210.2583e-12,198.628e-12,
ll10_2,209.5036e-12,197.848e-12,

basic chat system on perl under linux

Im trying to write some basic chat system just to learn perl. Im trying to get the chatlog into a 1 file and print new message if it's appears in the chatlog.dat file, So i've wrote a function that does almost the same thing, but I have got some problems and don't know how to solve them.
So now I have 2 problems!
I could not understand how to keep checkFile function always active (like multiprocession) to continuously check for new messages
This problem occurs when I'm trying to write a new message that will be appended into the chatlog. The Interpreter waits for my input on the line my $newMessage = <STDIN>;, but, what if someone writes a new message? it will not be shown until he press enter... how to void that?
my ($sec,$min,$hour) = localtime();
while(1){
my $userMessage = <STDIN>;
last if $userMessage eq "::quit";
`echo "($hour:$min:$sec): $userMessage" >>chatlog.dat`;
}
sub checkFile{
my $lastMessage = "";
my $newMessage = "";
while (1) {
my $context = `cat chatlog.dat`;
split(/\n/, $context);
$newMessage = $_[$#_];
if ($newMessage ne $lastMessage) {
print $newMessage;
$lastMessage = $newMessage;
}
}
}
First:
don't use echo within a perl script. It's nasty to shell escape when you've got perfectly good IO routines.
using cat to read files is about as nasty as using 'echo'.
reading <STDIN> like that will be a blocking call - which means your script will pause.
but that's not as bad as it sounds, because otherwise you're running a 'busy wait' loop which'll repeatedy cat the file. This is a very bad idea.
You're assuming writing a file like that is an atomic operation, when it's not. You'll hit problems with doing that too.
What I would suggest you do it look at IO::Handle and also consider using flock to ensure you've got the file locked for IO. You may also wish to consider File::Tail instead.
I would actually suggest though, you want to consider a different mode of IPC - as 'file swapping' is quite inefficient. If you really want to use the filesystem for your IO, you might want to consider using a FIFO pipe - have each 'client' open it's own, and have a server reading and coalescing them.
Either way though - you'll either need to use IO::Select or perhaps multithreading, just to swap back and forth between reading and writing. http://perldoc.perl.org/IO/Select.html
Answering my own question
sub checkFile{
my $lastMessage = "";
my $newMessage = "";
my $userName = $_[0];
while (1) {
my $context = `cat chatlog.dat`;
split(/\n/, $context);
$newMessage = $_[$#_];
if ($newMessage ne $lastMessage) {
$newMessage =~ /^\(.+\):\((.+)\) (.+$)/;
if ($1 ne $userName) { print "[$1]: $2";}
$lastMessage = $newMessage;
}
}
}
my $userName = "Rocker";
my ($sec,$min,$hour) = localtime();
my $thr = threads -> create ( \&checkFile, $userName ); #Starting a thread to continuously check for the file update
while (1) {
my $userMessage = <STDIN>; #STDIN will not interfere file checking
last if $userMessage eq "::quit";
`echo "($hour:$min:$sec):($userName) $userMessage" >>chatlog.dat` if $userMessage =~ /\S+/;
}
$thr -> join();

Resources