rr27 has asked for the wisdom of the Perl Monks concerning the following question:
I have to parse a formatted file of size 34M but its taking long about 30 min. Can you plz suggest changes to increase the speed?
#!usr/local/bin/perl @timeData=localtime(time); print "@timeData\n"; open FILE,"/usr/rr/xaa"; ### points ###### 1. create tables $count=0; $ban_gate=0; $path_gate=0; $ras_gate=0; $ldc_gate=0; my @col; my @data; my $adjust_flag=0; sub brace_rem { my($p)= @_; chop $p; $p=reverse $p; chop $p; $q= reverse $p; return "\'$q\'"; } ########### sqlite perl ########### use DBI; my $driver = "SQLite"; my $database = "test1.db"; my $dsn = "DBI:$driver:dbname=$database"; my $userid = ""; my $password = ""; $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die $DBI::errstr; sub table_create { my($tbname,@col)=@_; my $c; foreach $c(@col) { $c=brace_rem($c); } my @upcol=join(',',@col); my $sth=$dbh->prepare("CREATE TABLE $tbname (@upcol)"); my $rv = $sth->execute() or die $DBI::errstr; if($rv < 0){ print $DBI::errstr; } else { # print "Table $tbname created"; } } sub insert_data { my $d; my($tbname,@data)=@_; foreach $d(@data) { $d=brace_rem($d); } my @updata=join(',',@data); my $stmt = qq(INSERT INTO $tbname VALUES(@updata);); my $rv = $dbh->do($stmt) or die $DBI::errstr; } while(<FILE>) { ############# BANNER ################# if ($ban_gate==1) { if($_=~/END_BANNER/) { $ban_gate=0; table_create('FileInfo',@col); insert_data(FileInfo,@data); } else { @parts=/\{.*?\}/g; push(@col,$parts[0]); push(@data,$parts[1]); } } else { ### bangate=0 if($_=~/^BANNER/) { $ban_gate=1; } else { ## else of banner if($ras_gate==1) { if($_=~/END_REQ_CLC/ || $_=~/END_ARR_CLC/ || $_=~/END_SLK_ +CLC/) { $ras_gate=0; $tbname="$ras_token$pathno"; table_create($tbname,@col); insert_data($tbname,@data); } else { ## else of re with rasgate=1 @parts=/\{.*?\}/g; push(@col,$parts[1]); push(@data,$parts[2]); } } else { ### else of rasgate=0 if($_=~/(\s{2})REQ_CLC/ || $_=~/\s{2}SLK_CLC/ || $_=~/\s{2 +}ARR_CLC/) { $ras_gate=1; while (@col) {pop(@col);} while (@data) {pop(@data);} $ras_token=$_; chomp $ras_token; } else { ###### else of rasgate=0 and not req if ($ldc_gate==1) { if ($_=~/END_LAUNCH_CLK_PATH/ || $_=~/END_DATA_PATH/ | +| $_=~/END_CAP_CLK_PATH/) { $ldc_gate=0; } else {### else of rasgate=0 and not req and not endlau +nch, ldcgate=1 if($_=~/INST/ || $_=~/\s{4}HPIN/ || $_=~/\s{4}NET/ || +$_=~/\s{4}PORT/ ) { @parts=/\{.*?\}/g; while (@data) {pop(@data);} if ($flag==1 && $_=~/INST/) { for($i=0;$i<$#parts-2;++$i) { push(@data,$parts[$i]); } push(@data,"$parts[$i]$parts[$i+1]"); push(@data,$parts[$i+2]); } else { foreach $l (@parts) { push(@data,$l); } } insert_data($tbname,@data); } else {### else of inst net, rasgate=0 if($_=~/COLUMNS/) { @parts=/\{.*?\}/g; foreach $l (@parts) { if($l=~/adjustment/) {$flag=1; } else {$flag=0;} push(@col,$l); } $tbname="$ldc_token$pathno"; table_create($tbname,@col); } } } } else { ### ldcgate=0 if($_=~/(\s{2})LAUNCH_CLK_PATH/ || $_=~/\s{2}DATA_PATH +/ || $_=~/\s{2}CAP_CLK_PATH/) { $ldc_gate=1; $ldc_token=$_; while (@col) {pop(@col);} chomp $ldc_token; if($_=~/DATA_PATH/) { chop $ldc_token;} } } } } if($_=~/^PATH/) { @parts = split(/\s+/,$_); $pathno=$parts[1]; print "$pathno\n"; } } } } @timeData=localtime(time); print "@timeData\n"; $dbh->disconnect();
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Perl script speed
by davido (Cardinal) on May 30, 2014 at 05:00 UTC | |
by rr27 (Initiate) on May 30, 2014 at 05:22 UTC | |
by LanX (Saint) on May 30, 2014 at 14:13 UTC | |
by 2teez (Vicar) on May 30, 2014 at 06:32 UTC | |
|
Re: Perl script speed
by hippo (Archbishop) on May 30, 2014 at 08:31 UTC | |
by rr27 (Initiate) on May 30, 2014 at 09:48 UTC | |
by poj (Abbot) on May 30, 2014 at 11:50 UTC | |
by Laurent_R (Canon) on May 30, 2014 at 10:42 UTC | |
|
Re: Perl script speed
by roboticus (Chancellor) on May 30, 2014 at 21:48 UTC | |
|
Re: Perl script speed
by GrandFather (Saint) on May 30, 2014 at 21:35 UTC | |
by poj (Abbot) on May 31, 2014 at 06:24 UTC | |
by rr27 (Initiate) on Jun 02, 2014 at 11:19 UTC | |
by poj (Abbot) on Jun 02, 2014 at 12:38 UTC | |
by rr27 (Initiate) on Jun 02, 2014 at 13:11 UTC | |
by poj (Abbot) on Jun 02, 2014 at 15:43 UTC | |
|
Re: Perl script speed
by perlfan (Parson) on May 30, 2014 at 12:20 UTC | |
by GrandFather (Saint) on May 30, 2014 at 12:53 UTC |