in reply to Perl script speed

The following code which does (as far as I can tell) substantially what you want except that instead of creating a plethora of tables containing a single row, it generates a table per "signal" and adds a path number column. 4000 paths generates about a 30 MB "file" and runs in under 30 seconds.

#!usr/local/bin/perl use strict; use warnings; use DBI; my $fileStr = do {local $/; <DATA>}; my ($header, $meat) = $fileStr =~ /(.*)^PATH 1(.*)END_PATH 1.*/sm; my $dbName = 'test1.sqlite'; my $paths = 4000; $fileStr = join '', $header, map {"PATH $_${meat}END_PATH $_\n"} 1 .. +$paths; unlink $dbName; open my $fin, '<', \$fileStr; my $startTick = time (); run($fin, $dbName); my $seconds = time () - $startTick; print "Took $seconds for $paths paths\n"; sub run { my ($fin, $dbName) = @_; my $self = bless {fin => $fin}; my $dsn = "DBI:SQLite:dbname=$dbName"; my $userid = ""; my $password = ""; $self->{dbh} = DBI->connect($dsn, $userid, $password, {RaiseError +=> 1}) or die $DBI::errstr; my %dispatch = ( VERSION => sub { }, PTDEF => sub { }, BANNER => \&banner, PATH => \&path, ); $self->{dbh}->do('BEGIN TRANSACTION;'); while (defined (my $line = <$fin>)) { my ($key, $tail) = $line =~ /^(\w+)\s*(.*)/ or next; die "Parser doesn't understand $line" if !exists $dispatch{$ke +y}; $dispatch{$key}($self, $key, $tail); } $self->{dbh}->do('COMMIT TRANSACTION;'); } sub banner { my ($self, $key, $tail) = @_; my $fin = $self->{fin}; my @cols; my @values; while (defined (my $line = <$fin>)) { last if $line =~ /END_$key/; my ($key, $value) = $line =~ /\{([^}]+)\}/g or next; push @cols, $key; push @values, $value; } $self->table_create('FileInfo', @cols); $self->insertRow('FileInfo', @values); } sub path { my ($self, $key, $tail) = @_; my $fin = $self->{fin}; my %dispatch = ( REQ_CLC => \&rasGate, SLK_CLC => \&rasGate, ARR_CLC => \&rasGate, LAUNCH_CLK_PATH => \&ldcGate, DATA_PATH => \&ldcGate, CAP_CLK_PATH => \&ldcGate, ); $self->{pathNum} = $tail; print "Processing path $tail\n"; while (defined (my $line = <$fin>)) { last if $line =~ /END_$key/; my ($key, $tail) = $line =~ /^\s+(\w+)\s*(.*)/ or next; warn "Parser doesn't understand $line", next if !exists $dispa +tch{$key}; $dispatch{$key}($self, $key, $tail); } } sub rasGate { my ($self, $key, $tail) = @_; my $fin = $self->{fin}; my @cols; my @values; my $rasToken; while (defined (my $line = <$fin>)) { last if $line =~ /END_$key/; my (undef, $key, $value) = $line =~ /\{([^}]+)\}/g or next; push @cols, $key; push @values, $value; } $self->table_create($key, 'Path', @cols); $self->insertRow($key, $self->{pathNum}, @values); } sub ldcGate { my ($self, $key, $tail) = @_; my $fin = $self->{fin}; my %dispatch = ( COLUMNS => \&ldcColumns, INST => \&instLine, HPIN => \&ldcLine, NET => \&ldcLine, PORT => \&ldcLine, ); $self->{ldcKey} = $key; $self->{rows} = []; while (defined (my $line = <$fin>)) { last if $line =~ /END_$key/; my ($key, $tail) = $line =~ /^\s*(\w+)\s*(.*)/ or next; die "Parser doesn't understand $line" if !exists $dispatch{$ke +y}; $dispatch{$key}($self, $key, $tail); } $self->{ldcSth}->execute($self->{pathNum}, @$_) for @{$self->{rows +}}; } sub ldcLine { my ($self, $key, $tail) = @_; push @{$self->{rows}}, [map {defined ($_) ? $_ : ''} $tail =~ /\{([^}]*)\}/g]; } sub instLine { my ($self, $key, $tail) = @_; my @values = map {defined ($_) ? $_ : ''} $tail =~ /\{([^}]*)\}/g; $values[-3] = "$values[-3]$values[-2]"; splice @values, $#values - 1, 1; push @{$self->{rows}}, \@values; } sub ldcColumns { my ($self, $key, $tail) = @_; my @cols = $tail =~ /\{([^}]+)\}/g; $self->table_create($self->{ldcKey}, 'Path', @cols); my $places = join ', ', ('?') x @cols; my $stmt = qq(INSERT INTO '$self->{ldcKey}' VALUES(?, $places);); $self->{ldcSth} = $self->{dbh}->prepare($stmt) or die $DBI::errstr +; } sub table_create { my ($self, $tbname, @cols) = @_; my $columns = "'" . join ("', '", @cols) . "'"; return if $self->{haveTable}{$tbname}++; my $sth = $self->{dbh}->prepare("CREATE TABLE $tbname ($columns)") +; my $rv = $sth->execute() or die $DBI::errstr; if ($rv < 0) { print $DBI::errstr; } else { # print "Table $tbname created"; } } sub insertRow { my ($self, $tbname, @data) = @_; my $places = join ', ', ('?') x @data; my $stmt = qq(INSERT INTO $tbname VALUES($places);); my $sth = $self->{dbh}->prepare($stmt) or die $DBI::errstr; $sth->execute(@data) or die $DBI::errstr; }

Tack the following __DATA__ to the end of the script before running it, or alter the code to use an external file.

Perl is the programming world's equivalent of English

Replies are listed 'Best First'.
Re^2: Perl script speed
by poj (Abbot) on May 31, 2014 at 06:24 UTC

    I think the regex in rasGate should to be

    my (undef, $key, $value) = $line =~ /\{([^}]*)\}/g or next; # * not +

    to parse the empty brackets {} correctly otherwise you get a column called 0.0000 in the table.

    ARR_CLC {} {Clock Rise Edge} {0.0000} {+} {Drive Adjustment} {1.3300} {=} {Beginpoint Arrival Time} {1.3300} END_ARR_CLC
    poj
Re^2: Perl script speed
by rr27 (Initiate) on Jun 02, 2014 at 11:19 UTC
    Thanx a lot!! But I am facing an error of  DBD::SQLite::st execute failed: called with 16 variables when 17 are needed This is at the line
    $self->{ldcSth}->execute($self->{pathNum}, @$_) for @{$self->{rows}}; }
    of ldcGate. Please can you explain how to solve this error.

      Am I right in thinking that some of lines only have 16 columns, ie no adjustment ?

      COLUMNS {instance} {fpin} {fedge} {tpin} {tedge} {net} {cell} {del +ay} {incr_delay} {slew} {load} {arrival} {required} {stolen} {fanout} + {pin_location} {adjustment}
      Update:
      I ask because in your code you have these parts which I guess deal with the extra column by concatenating 2 together
      if ($l=~/adjustment/) { $flag=1; }
      and
      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); } }

      poj
        ya, I have portions in the file which have extra column. but it is not the problem area. Even the columns having 16 without adjustment is showing this error.