Hello sar123, and welcome to the Monastery!

By the time the conditional:

if ($_ =~ /^xa1/) {
[download]

becomes true in the main while loop, the $fh file pointer has already been moved past the part of the data file you want getsub() to read. You will have to reset it using seek. But be sure to return it to its former position before exiting the subroutine, or you will enter an infinite loop! Best to make it local within getsub, like this (untested):

Update 1: Turns out that local doesn’t work the way I hoped it would. :-( This works:

use strict;
use warnings;

open(my $fh, '<', $ARGV[0]) or die "Could not open file: $!";

sub getsub
{
    my $sub = $_[0];
    print "sub entered for $sub\n";

    open my $fh2, '<', 'subs.txt' or die "Could not open file: $!";

    while (<$fh2>)
    {
        print if /\.subckt $sub/ .. /\.ends/;
    }

    close $fh2 or die "Could not close file: $!";
}

while (my $line = <$fh>)
{
    if ($line =~ /^xa1/)
    {
        print "line found to be $line\n";

        while ((my $nxt = readline($fh)) =~ /^\+/)
        {
            $line = $nxt;
            print "line changed to $line\n";
        }

        $line =~ s/\s+$//;
        print  "last line is $line\n";
        my $sub = (split '\s', $line)[-1];
        print "subcircuit found is $sub in $line\n"; 
        my $file_pos = tell $fh;
        getsub($sub);
        seek $fh, $file_pos, 0;
    }
}

close $fh or die "Could not close file: $!";
[download]

Output:

 2:55 >perl 1032_SoPW.pl subs.txt
line found to be xa1 a s f a1

last line is xa1 a s f a1
subcircuit found is a1 in xa1 a s f a1
sub entered for a1
.subckt a1 x y z
   xa a b c1
   xb c d e1
   xc f g h1
 .ends

 2:56 >
[download]

Update 2: To eliminate the warning that arises when the line beginning xa1 is the last line in the data file, change:

while ((my $nxt = readline($fh)) =~ /^\+/)
[download]

to:

while (!eof && (my $nxt = readline($fh)) =~ /^\+/)
[download]

Hope that helps,

Actually I have to run the above code recursively to get the result: So here is my complete code:

#!/usr/bin/perl -w
use diagnostics;
use warnings;

open $fh, "<", "$ARGV[0]" or die "Could not open $ARGV[0]: $!";
sub getsub{
        my $sub = $_[0];
        print "inside sub for $sub\n";
        seek $fh, 0, 0;
        while  (<$fh>) {
        if (/\.subckt $sub/../\.ends/)  {
                print "starting from $_\n";
                if (/^x/) {
                        $line = $_;
                        while (($nxt = readline($fh)) =~ /^\+/) {
                                $line = $nxt;
#                               print "line changed to $line\n";
                        }
                        $line =~ s/\s+$//;
#                       print  "last line is $line\n";
                        my $sub = (split '\s', $line)[-1];
                        print "subcircuit found is $sub in $line\n";
            my $pos = tell($fh);
                        print "position in file set to $pos\n";
                        getsub ($sub);
                        seek $fh, $pos, 0;
                        $pos = tell ($fh);
                        print "position in file restored to $pos\n";
            print "line is now $_";
                }
        }
        }
}

while  (<$fh>) {
        if ($_ =~ /^xa1/) {
                $line = $_;
                print "line found to be $line\n";
                while (($nxt = readline($fh)) =~ /^\+/) {
                        $line = $nxt;
                        #print "line changed to $line\n";
                }
        $line =~ s/\s+$//;
#       print  "last line is $line\n";
        my $sub = (split '\s', $line)[-1];
        print "subcircuit found is $sub in $line\n";
        getsub($sub);
        }
}
[download]

The file on which I am running the code is too big to be shared. The problem I am getting is inside the subroutine. What I want is whenever I return from the recursive call from the subroutine I want to start from the position where I left off in that routine. So I saved the position in $pos and used that in seek after the recursive call as suggested by you. When I return back from a recursive call I tried to check the line which I am on using the print statement at the end of the subroutine. But it shows $_ to be blank. Also, the if block starts from the beginning again creating an infinite loop. Why is this happening?

Hello again sar123,

I agree with Anonymous Monk below that it would be much more efficient to read the input file once, storing its contents into a hash or other suitable data structure, and then to access the data from memory, than it is to re-read the file each time getsub is called. But the following observations refer to the strategy you have adopted:

Why do you need sub getsub to call itself recursively? Your code as shown violates the DRY principle of software development, by repeating code from the main while loop in the subroutine. Here’s my guess as to what’s going on: if the input file contains successive lines like this:

xa1 b t g e1
xa1 a s f a1
[download]

the second is ignored. But the reason for this is the logic of the code beginning:

while (($nxt = readline($fh)) =~ /^\+/) {
[download]

and the solution is not recursion, but re-casting the logic:

Read more... (2 kB)

If this doesn’t solve your problem, then as frozenwithjoy says you will need to provide more information, including a minimal but complete example script together with sample input and desired output.

By the way, you really should get into the habit of coding with:

use strict;
[download]

— this will save you a lot of debugging time down the track. And note that:

#!/usr/bin/perl -w
...
use warnings;
[download]

is redundant; use warnings; is generally preferred over -w because the former is lexically scoped, whereas the latter has global effect.

Hope that helps,

Athanasius <°(((>< contra mundum

Iustus alius egestas vitae, eros Piratica,

The file on which I am running the code is too big to be shared.

Can you post a representative sample of the file that can be used for easier troubleshooting?

Store the .subckt blocks in a hash:

my %subckt;
my $name;
my $want;

while (<DATA>) {
    if (my $ff = /\.subckt\s+(\w+)/ .. /\.ends/) {
        $name = $1 if $ff == 1;
        $subckt{$name} .= $_;
    } else {
        $want = $1 if /^\s*xa1\b.*\b(\w+)\s*$/;
    }
}

print $subckt{$want};
[download]