I am not able to link the regexp logic to match it based on the output file . Could you help me out ?

So you don't have an algorithm and have been unable to write one? I would suggest something like this.

1. Parse the Pin Numbers and store them as strings in an array.
2. Parse/store the next scan line.
3. Extract positions of carets in the following line.
4. Associate these with the H/L values stored at 2 and the pins at 1. Print a line of output for each caret.
5. Go to 2 until the input has all been read.

Re^2: Grab 3 lines before and 2 after each regex hit (sliding window)

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11110110
use warnings;

$_ = do { local $/; <DATA> };

print " pattern offset pin_num\n";
while( /\^/g )
  {
  my $pre = $`;
  my ($pattern, $offset) = $pre =~ /^(\S+)\s+(\S+).*\n(.*)\z/m;
  my $mask = $3 =~ tr//\0/cr . "\xff";
  my $column = join '', map +($_ & $mask) =~ tr/\0//dr, split /^/, $pr
+e;
  my ($pin, $hl) = $column =~ /(...).*(.)/;
  printf "%6s%7s%7s%9s\n", $pattern, $offset, $pin, $hl;
  }

__DATA__

                                        p p p p p
Pin Numbers                             3 2 1 8 9
                                        1 2 3 4 5

pattern     offset
scan1        2965                       H L H L H
                                            ^
scan2        2200                       L H H L H
                                          ^
scan3        1100                       H L L L L
                                          ^
scan4        1500                       L L H H H
                                            ^
scan5        2800                       H H L H H
                                          ^     ^
[download]

Hi tybalt89 ,

Thanks for your help! I have tried the script but there is one problem , I am getting the below stated errors ,

Bareword found where operator expected at script.pl line 13, near "tr//\0/cr"

Bareword found where operator expected at script.pl line 14, near "tr/\0//dr"

I am using perl version 5.10 and cant change it to the other latest version since I dont have administrator right Can we tweak the provided solution to make it work 5.10 ?

Thanks and Regards

Kshitij Kulshreshtha

First, don't manually copy code from perlmonks, use the download link below the code. That prevents typos.

Second, don't assume any code posted at perlmonks will solve your problem. Some people post untested or intentionally bad code, some of them to make you learn, some just don't know better, and some are simply assholes. tybalt89 has a long history of posting completely undocumented, completely unexplained code, often needlessly complex or obfuscated, often working only accidently.

Third, perlmonks is not a code writing service. We are here to help you learn perl, not to write code for you. (And this is part of the motivation for people posting bad code.)

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11110110
use warnings;

$_ = do { local $/; <DATA> };

print " pattern offset pin_num\n";
while( /\^/g )
  {
  my $pre = $`;
  my ($pattern, $offset) = $pre =~ /^(\S+) +(\S+).*\n(.*)\z/m;
  my $skip = length $3;
  printf "%6s%7s%5s%s%s%9s\n", $pattern, $offset,
    ($pre =~ /^.{$skip}(\w)/gm)[ 0..2, -1]
  }

__DATA__

                                        p p p p p
Pin Numbers                             3 2 1 8 9
                                        1 2 3 4 5

pattern     offset
scan1        2965                       H L H L H
                                            ^
scan2        2200                       L H H L H
                                          ^
scan3        1100                       H L L L L
                                          ^
scan4        1500                       L L H H H
                                            ^
scan5        2800                       H H L H H
                                          ^     ^
[download]

Can you tweak it?

G'day kshitij,

"I am not able to link the regexp logic to match it based on the output file"

That shouldn't matter as "regexp logic" is not required here. You can do this with Perl's string-handling functions; which are quite likely to be faster than a regex solution (test with Benchmark).

This code:

#!/usr/bin/env perl

use strict;
use warnings;

my $scan_data_found = 0;
my @pins;
my $format = "%-7s %-6s %-7s %s\n";
my @scan_line_data;

printf $format, qw{pattern offset pin_num H/L};

while (<DATA>) {
    chomp;
    next unless length;

    if ($scan_data_found) {
        if (@scan_line_data) {
            my $caret_pos = 0;

            while (1)  {
                $caret_pos = index $_, '^', $caret_pos;
                last if $caret_pos == -1;
                printf $format, @scan_line_data[0,1],
                    join('', map $_->[$caret_pos], @pins),
                    $scan_line_data[2][$caret_pos];
                ++$caret_pos;
            }

            @scan_line_data = ();
        }
        else {
            push @scan_line_data, ((split ' ')[0,1], [split //]);
        }
    }
    else {
        if (0 == index $_, 'pattern') {
            $scan_data_found = 1;
        }
        else {
            push @pins, [split //];
        }
    }
}

__DATA__

                                        p p p p p
Pin Numbers                             3 2 1 8 9
                                        1 2 3 4 5

pattern     offset
scan1        2965                       H L H L H
                                            ^
scan2        2200                       L H H L H
                                          ^
scan3        1100                       H L L L L
                                          ^
scan4        1500                       L L H H H
                                            ^
scan5        2800                       H H L H H
                                          ^     ^
[download]

Produces this output:

pattern offset pin_num H/L
scan1   2965   p13     H
scan2   2200   p22     H
scan3   1100   p22     L
scan4   1500   p13     H
scan5   2800   p22     H
scan5   2800   p95     H
[download]

The split function does take a regex as its first argument; however, that's not the line matching regex you were talking about.

If the positions of all the characters are very strict you may be able to write a program to determine those positions. Once you have those positions you could proceed with parsing the 'scan' lines. Here is a small code excerpt that you could use:

use strict ;
use warnings ;

my @pins = qw(31 22 13 84 95) ;
my @positions = (40,42, 44, 46, 48) ;

while (<DATA>) {
    my $line = $_;
    my $scan ;
    my $offset ;
    if ( $line =~ /(scan\d+)\s*(\d+)/ ) {
        $line = $line . <DATA> ;
        $scan = $1 ;
        $offset = $2 ;
    }
    for my $i (0..$#positions) {
        $_ = $positions[$i] ;
        my $pin = "p" . $pins[$i] ;
        if ( $line =~ /^.{$_}([HL]).*?\n.{$_}[\^]/ ) {
            print "$scan $offset $pin $1\n" ;
        }
    }
}

__DATA__
scan1        2965                       H L H L H
                                            ^
scan2        2200                       L H H L H 
                                          ^
scan3        1100                       H L L L L 
                                          ^
scan4        1500                       L L H H H 
                                            ^
scan5        2800                       H H L H H
                                          ^     ^
[download]

Output:

scan1 2965 p13 H
scan2 2200 p22 H
scan3 1100 p22 L
scan4 1500 p13 H
scan5 2800 p22 H
scan5 2800 p95 H
[download]